Implemented SexpC translator.

Pascal J. Bourguignon [2019-06-02 20:21]
Implemented SexpC translator.
Filename
languages/linc/Makefile
languages/linc/annex-a.lisp
languages/linc/c-operators.lisp
languages/linc/c-runtime.lisp
languages/linc/c-sexp-compiler.lisp
languages/linc/c-sexp-language.lisp
languages/linc/c-sexp-loader.lisp
languages/linc/c-sexp-test.lisp
languages/linc/c-sexp-translator.lisp
languages/linc/c-string-reader.lisp
languages/linc/c-syntax-test.lisp
languages/linc/c-syntax.lisp
languages/linc/com.informatimago.languages.linc.asd
languages/linc/indent.el
languages/linc/linc.lisp
languages/linc/loader.lisp
languages/linc/notes.org
languages/linc/packages.lisp
languages/linc/readtable-test.lisp
languages/linc/readtable.lisp
languages/linc/run.lisp
languages/linc/test-c-array.c
languages/linc/test-c-empty-struct-union.c
languages/linc/test-c-struct-bit.c
languages/linc/test-c-syntax.lisp
languages/linc/test-expressions.sexpc
languages/linc/test-ii.lisp
languages/linc/test-include.sexpc
languages/linc/test-statements.sexpc
languages/linc/test-types.sexpc
languages/linc/test.c
languages/linc/test.lisp
languages/linc/test.sexph
languages/linc/utilities.lisp
diff --git a/languages/linc/Makefile b/languages/linc/Makefile
new file mode 100644
index 0000000..ae884ba
--- /dev/null
+++ b/languages/linc/Makefile
@@ -0,0 +1,10 @@
+all:help
+help:
+	@printf "make clean\n"
+clean:
+	-rm -rf *.o *.dSYM $(TEST_PROGRAMS) $(TEST_INTERMEDIARIES)
+TEST_PROGRAMS = \
+	test-c-array test-c-empty-struct-union test-c-struct-bit \
+	test-expressions test-include test-statements test-types
+TEST_INTERMEDIARIES = \
+	test-expressions.c	test-include.c	test-statements.c	test-types.c
diff --git a/languages/linc/annex-a.lisp b/languages/linc/annex-a.lisp
index 593ad31..923bbe9 100644
--- a/languages/linc/annex-a.lisp
+++ b/languages/linc/annex-a.lisp
@@ -1,4 +1,8 @@
-(defparameter *ansi-c-grammar*
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(defparameter *ansi-c-grammar*
   '(("(6.4)" token -->
      keyword
      identifier
@@ -636,7 +640,7 @@
     ("(6.10)" group -->
      group-part
      (group group-part))
-
+
     ("(6.10)" group-part -->
      if-section
      (control-line text-line)
@@ -677,19 +681,23 @@

     ("(6.10)" text-line -->
      ((opt pp-tokens) new-line))
-
+
     ("(6.10)" non-directive -->
      (pp-tokens new-line))
-
+
     ("(6.10)" lparen -->
      |a ( character not immediately preceded by white-space|)
-
+
     ("(6.10)" replacement-list -->
      (opt pp-tokens))
-
+
     ("(6.10)" pp-tokens -->
      preprocessing-token
      (pp-tokens preprocessing-token))

     ("(6.10)" new-line -->
      |the new-line character|)))
+
+
+
+
diff --git a/languages/linc/c-operators.lisp b/languages/linc/c-operators.lisp
index f3a4f65..03a4abf 100644
--- a/languages/linc/c-operators.lisp
+++ b/languages/linc/c-operators.lisp
@@ -35,14 +35,14 @@
   (setf *readtable* (copy-readtable nil)))
 (in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")

-(make-declare com.informatimago.languages.linc.c::variable  "A variable.")
-(make-declare com.informatimago.languages.linc.c::class     "A class.")
-(make-declare com.informatimago.languages.linc.c::struct    "A struct.")
-(make-declare com.informatimago.languages.linc.c::union     "A union.")
-(make-declare com.informatimago.languages.linc.c::type      "A type.")
-(make-declare com.informatimago.languages.linc.c::enum      "An enum.")
-(make-declare com.informatimago.languages.linc.c::function  "A function.")
-(make-declare com.informatimago.languages.linc.c::macro     "A preprocessor macro.")
+(make-declare variable  "A variable.")
+(make-declare class     "A class.")
+(make-declare struct    "A struct.")
+(make-declare union     "A union.")
+(make-declare type      "A type.")
+(make-declare enum      "An enum.")
+(make-declare function  "A function.")
+(make-declare macro     "A preprocessor macro.")

 (gen-operators)

diff --git a/languages/linc/c-runtime.lisp b/languages/linc/c-runtime.lisp
new file mode 100644
index 0000000..73330ce
--- /dev/null
+++ b/languages/linc/c-runtime.lisp
@@ -0,0 +1,7 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC.C-RUNTIME")
+
+(defun initialize ()
+  (values))
diff --git a/languages/linc/c-sexp-compiler.lisp b/languages/linc/c-sexp-compiler.lisp
new file mode 100644
index 0000000..ee456a2
--- /dev/null
+++ b/languages/linc/c-sexp-compiler.lisp
@@ -0,0 +1,8 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+
+(defun compile-linc-file ()
+  )
+
diff --git a/languages/linc/c-sexp-language.lisp b/languages/linc/c-sexp-language.lisp
new file mode 100644
index 0000000..59fdaf6
--- /dev/null
+++ b/languages/linc/c-sexp-language.lisp
@@ -0,0 +1,170 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC.C-SEXP-LANGUAGE")
+
+#|
+
+The C Sexp Sources can be interpreted by two systems:
+
+- Common Lisp usual LOAD and COMPILE-FILE, (wrapped in LOAD-LINC-FILE
+  and COMPILE-LINC-FILE to setup the C reader macros and environment)
+  which expands the toplevel forms (macros) into Common Lisp code
+  interpring them using the C semantics embedded in Common Lisp via a
+  C-like runtime.  This allows to develop and debug code in the CL
+  environment, to later be translated to C.
+
+- LINC TRANSLATE-LINC-FILE, which generates a C source file.
+
+|#
+
+;; pre-processor directives
+
+(defmacro .ifdef (symbol &body toplevel-forms)
+  )
+
+(defmacro .ifndef (symbol &body toplevel-forms)
+  )
+
+(defmacro .if (constant-expression &body toplevel-forms)
+  "
+  .elif constant-expression
+  .else
+"
+  )
+
+(defmacro include (file)
+  "
+(include <file>)
+(include \"file\")
+"
+
+  )
+
+(defmacro define-macro     (name &rest optional-lambda-list-and-expansion)
+  )
+
+
+
+;; type expressions:
+
+(defparameter *type-qualifiers*
+  '(const restrict volatile atomic))
+
+(defparameter *type-qualifier-map*
+  '((atomic    . |_Atomic|)))
+
+(defparameter *type-specifier*
+  '(void char short int long float double signed unsigned bool complex))
+
+(defparameter *type-specifier-map*
+  '((bool    . |_Bool|)
+    (complex . |_Complex|)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun struct-union-enum (type name-and-slots)
+    (let ((name  (if (symbolp (first name-and-slots))
+                     (first name-and-slots)
+                     nil))
+          (slots (if (symbolp (first name-and-slots))
+                     (rest name-and-slots)
+                     name-and-slots)))
+      `(,type ,name ,slots))))
+
+(defmacro struct  (&rest name-and-slots)  (struct-union-enum 'struct name-and-slots))
+(defmacro union   (&rest name-and-slots)  (struct-union-enum 'union  name-and-slots))
+(defmacro enum    (&rest name-and-values) (struct-union-enum 'enum   name-and-values))
+(defmacro atomic  (type) `(atomic  ,type))
+(defmacro pointer (type) `(pointer ,type))
+(defmacro array   (type &optional size) `(array ,type ,size))
+
+#|
+(struct foo)
+(struct foo (x int) (y int (bits 3)))
+(struct     (x int) (y int (bits 3)))
+
+(union foo)
+(union foo (x int) (y int (bits 3)))
+(union     (x int) (y int (bits 3)))
+
+(enum bar)
+(enum bar   x    y z)
+(enum bar  (x 0) y z)
+(enum      (x 0) y z)
+
+<identifier>
+
+(atomic type)
+
+(pointer type)
+
+;; char*
+(pointer char)
+
+;; char* []
+(array (pointer char))
+;; char* [42]
+(array (pointer char) 42)
+
+
+
+     (direct-declarator \[ (opt type-qualifier-list) (opt assignment-expression) \])
+     (direct-declarator \[ static (opt type-qualifier-list) assignment-expression \])
+     (direct-declarator \[ type-qualifier-list static assignment-expression \])
+     (direct-declarator \[ (opt type-qualifier-list) \* \])
+
+
+(align-as type)
+(align-as const-expression)
+|#
+
+;; declarations:
+
+(defmacro declare-structure   (name &rest slots)
+  "
+WILL GENERATE:
+
+    struct ,name {
+       ,@slots
+    };
+"
+  `(struct ,name ,@slots))
+
+(defmacro declare-union       (name &rest alternatives)
+    "
+WILL GENERATE:
+
+    union ,name {
+       ,@alternatives
+    };
+"
+  `(union ,name ,@alternatives))
+
+(defmacro declare-type        (name &rest type)
+  "
+WILL GENERATE:
+
+    typedef ,type ,name;
+"
+  `(typedef ,name ,type)
+  )
+
+(defmacro declare-enumeration (name &rest options-and-values)
+  )
+
+(defmacro declare-constant    (name &rest options-and-type)
+  )
+
+(defmacro declare-variable    (name &rest options-and-type)
+  )
+
+(defmacro declare-function    (name &rest options-and-lambda-list-and-type)
+  )
+
+;; definitions:
+
+(defmacro define-constant  (name &rest options-and-type-and-value)
+  )
+(defmacro define-variable  (name &rest options-and-type-and-value)
+  )
+(defmacro define-function  (name &rest options-and-lambda-list-and-type-and-body)
+  )
diff --git a/languages/linc/c-sexp-loader.lisp b/languages/linc/c-sexp-loader.lisp
new file mode 100644
index 0000000..9181a3c
--- /dev/null
+++ b/languages/linc/c-sexp-loader.lisp
@@ -0,0 +1,44 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(defun linc-eval (form)
+  0)
+
+(defun load-linc-file (input-file &key output-file
+                                    (verbose *compile-verbose*)
+                                    (print *compile-print*)
+                                    (external-format :default)
+                                    (if-does-not-exist :error))
+  (let ((*package*         (com.informatimago.common-lisp.interactive.interactive:mkupack
+                            :name "com.informatimago.languages.linc.c-"
+                            :use '("COM.INFORMATIMAGO.LANGUAGES.LINC.C")))
+        (*readtable*       (copy-readtable com.informatimago.languages.linc::*c-readtable*))
+        (*compile-verbose* verbose)
+        (*compile-print*   print)
+        (warnings-p        nil)
+        (failure-p         nil))
+    (with-open-file (input input-file
+                           :external-format external-format
+                           :if-does-not-exist (when if-does-not-exist :error))
+      (handler-bind ((warning       (lambda (condition)
+                                        (declare (ignore condition))
+                                        (incf warnings-p)
+                                        nil))
+                       (style-warning (lambda (condition)
+                                        (declare (ignore condition))
+                                        nil))
+                       (error         (lambda (condition)
+                                        (format *error-output* "~&;; ~A~%" condition)
+                                        (invoke-restart (find-restart 'continue-translation condition)))))
+          (loop
+            :for form := (read input nil input)
+            :until (eql form input)
+            :do (when print
+                  (format t "~&~S~%" form))
+                (let ((result  (linc-eval form)))
+                  (when verbose
+                    (format t "~&-> ~S~%" result)))
+            :finally (return t))))))
+
+;;;; THE END ;;;;
diff --git a/languages/linc/c-sexp-test.lisp b/languages/linc/c-sexp-test.lisp
new file mode 100644
index 0000000..673fdf1
--- /dev/null
+++ b/languages/linc/c-sexp-test.lisp
@@ -0,0 +1,7 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(assert (string= (with-output-to-string (*c-out*)
+           (generate (parse-pointer-type  '(|pointer| |restrict| (|pointer| |const| |int|)))))
+         "int * const * restrict"))
diff --git a/languages/linc/c-sexp-translator.lisp b/languages/linc/c-sexp-translator.lisp
new file mode 100644
index 0000000..f0ac0bf
--- /dev/null
+++ b/languages/linc/c-sexp-translator.lisp
@@ -0,0 +1,1381 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(defvar *translate-linc-verbose*  nil)
+(defvar *translate-linc-print*    nil)
+(defvar *translate-linc-pathname* nil)
+(defvar *translate-linc-truename* nil)
+(defvar *source-form*             nil)
+
+(defparameter *allow-print-backtrace* t)
+
+(defun print-backtrace (&optional (output *error-output*))
+  #+ccl (when *allow-print-backtrace*
+          (let ((*allow-print-backtrace* nil))
+            (format output "~&~80,,,'-<~>~&~{~A~%~}~80,,,'-<~>~&"
+                    (ccl::backtrace-as-list)))))
+
+(define-condition linc-error (simple-error)
+  ())
+
+(define-condition linc-program-error (linc-error)
+  ((source-form :initarg :source-form :reader linc-program-error-source-form)
+   (source-file :initarg :source-file :reader linc-program-error-source-file))
+  (:report (lambda (condition stream)
+             (let ((*print-readably* nil)
+                   (*print-escape* nil)
+                   (*print-case* :downcase))
+               (format stream "~?~%in form: ~A~%in file: ~S~%"
+                       (simple-condition-format-control condition)
+                       (simple-condition-format-arguments condition)
+                       (linc-program-error-source-form condition)
+                       (linc-program-error-source-file condition))))))
+
+(define-condition linc-internal-error (linc-program-error)
+  ())
+
+(define-condition linc-stray-atom-error (linc-program-error)
+  ())
+
+(define-condition linc-invalid-operator-error (linc-program-error)
+  ())
+
+(define-condition linc-not-implemented-yet-error (linc-program-error)
+  ((operator :initarg :operator :reader linc-not-implemented-yet-error-operator)))
+
+(defun not-implemented-yet (operator form)
+  (error 'linc-not-implemented-yet-error
+         :operator operator
+         :source-form form
+         :source-file *translate-linc-truename*
+         :format-control "Not implemented yet: ~S"
+         :format-arguments (list operator)))
+
+;;;---------------------------------------------------------------------
+
+(defparameter *c-keywords* '(|*| |auto| |break| |case| |char| |const|
+                             |continue| |default| |do| |double| |else|
+                             |enum| |extern| |float| |for| |goto| |if|
+                             |inline| |int| |long| |register|
+                             |restrict| |return| |short| |signed|
+                             |sizeof| |static| |struct| |switch|
+                             |typedef| |union| |unsigned| |void|
+                             |volatile| |while|
+                             ;; ----
+                             |_Alignas| |_Alignof| |_Atomic| |_Bool|
+                             |_Complex| |_Generic| |_Imaginary|
+                             |_Noreturn| |_Static_assert|
+                             |_Thread_local|
+                             ;; ---- aliases:
+                             |align-as| |align-of| |atomic| |bool|
+                             |complex| |generic| |imaginary|
+                             |noreturn| |static-assert|
+                             |thread-local|))
+
+(defun c-keyword-p (name)
+  (declare (ignore name))
+  (find name *c-keywords*))
+
+(defun c-identifier-p (name)
+  (and (symbolp name)
+       (not (c-keyword-p name))))
+
+(defun check-identifier (name)
+  (unless (c-identifier-p name)
+    (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                               :format-control "Invalid identifier: ~S"
+                               :format-arguments (list name))))
+
+;;;---------------------------------------------------------------------
+;;; Pre-processor
+
+(defun parse-include (form)
+  ;; (include <foo.h>|"foo.h" …)
+  (let ((files (rest form)))
+    (when (null files)
+      (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                 :format-control "Missing file in include form."))
+    (make-instance 'c-sequence
+                   :elements (mapcar (lambda (file)
+                                       (typecase file
+                                         (symbol
+                                          (let ((name (string file)))
+                                            (if (and (< 2 (length name))
+                                                     (char= #\< (aref name 0))
+                                                     (char= #\> (aref name (- (length name) 1)))
+                                                     (not (find-if (lambda (ch) (find ch "<>"))
+                                                                   (subseq name 1 (- (length name) 1)))))
+                                                (include :system (subseq name 1 (- (length name) 1)))
+                                                (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                                           :format-control "Invalid file name in include form: ~A"
+                                                                           :format-arguments (list (symbol-name file))))))
+                                         (string
+                                          (if (and (< 1 (length file))
+                                                   (not (find #\" file)))
+                                              (include :local file)
+                                              (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                                         :format-control "Invalid file file in include form: ~S"
+                                                                         :format-arguments (list file))))
+                                         (otherwise
+                                          (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                                     :format-control "Invalid file name in include form: ~S"
+                                                                     :format-arguments (list file)))))
+                                     files))))
+
+(defun parse-ifdef (form)
+  (not-implemented-yet 'parse-ifdef form))
+
+(defun parse-ifndef (form)
+  (not-implemented-yet 'parse-ifndef form))
+
+(defun parse-if (form)
+  (not-implemented-yet 'parse-if form))
+
+
+
+
+;;;---------------------------------------------------------------------
+;;; Types
+
+(defparameter *storage-classes*
+  '(|typedef| |extern| |static| |thread-local| |auto| |register|))
+
+(defparameter *storage-classes-map*
+  '((|thread-local| . |_Thread_local|)))
+
+(defparameter *type-qualifiers*
+  '(|const| |restrict| |volatile| |atomic|))
+
+(defparameter *type-qualifiers-map*
+  '((|atomic|  . |_Atomic|)))
+
+(defparameter *type-specifiers*
+  '(|void| |char| |short| |int| |long| |float| |double| |signed| |unsigned| |bool| |complex|))
+
+(defparameter *type-specifiers-map*
+  '((|bool|    . |_Bool|)
+    (|complex| . |_Complex|)))
+
+(defparameter *type-constructors*
+  '(|struct| |enum| |union| |atomic|))
+
+(defparameter *type-declarators*
+  '(|pointer| |array| |function|))
+
+(defparameter *compound-types*  (concatenate 'list *type-constructors* *type-declarators*))
+
+(defun compound-type-form-p (form)
+  (and (listp form) (find (first form) *compound-types*)))
+
+ (defun function-specifier-p (item)
+   (find item '(|inline| |noreturn|)))
+
+(defparameter *scalar-types* '(((|void|))
+                               ((|char|))
+                               ((|signed| |char|))
+                               ((|unsigned| |char|))
+                               ((|short|) (|signed| |short|) (|short| |int|) (|signed| |short| |int|))
+                               ((|unsigned| |short|) (|unsigned| |short| |int|))
+                               ((|int|) (|signed|) (|signed| |int|))
+                               ((|unsigned|) (|unsigned| |int|))
+                               ((|long|)  (|signed| |long|)  (|long| |int|)   (|signed| |long| |int|))
+                               ((|unsigned| |long|)  (|unsigned| |long| |int|))
+                               ((|long| |long|)  (|signed| |long| |long|)  (|long| |long| |int|)  (|signed| |long| |long| |int|))
+                               ((|unsigned| |long| |long|)  (|unsigned| |long| |long| |int|))
+                               ((|float|))
+                               ((|double|))
+                               ((|long| |double|))
+                               ((|bool|))
+                               ((|float| |complex|))
+                               ((|double| |complex|))
+                               ((|long| |double| |complex|))))
+
+
+(defun ensure-type-list (type)
+  (if (or (atom type)
+          (compound-type-form-p type))
+      (list type)
+      type))
+
+(defun split-storage-classes-and-type-qualifiers (list)
+  (loop
+    :for (item . rest) :on list
+    :while (or (member item *storage-classes*)
+               (member item *type-qualifiers*))
+    :if (member item *storage-classes*)
+      :collect item :into storage-classes
+    :else
+      :collect item :into type-qualifiers
+    :finally (return (values storage-classes type-qualifiers (cons item rest)))))
+
+(defun split-type (tokens)
+  (loop
+    :for token :in tokens
+    :if rest
+      :collect token :into rest
+    :else :if (member token *storage-classes*)
+            :collect token :into storage-classes
+    :else :if (member token *type-qualifiers*)
+            :collect token :into type-qualifiers
+    :else :if (member token *type-specifiers*)
+            :collect token :into type-specifiers
+    :else :if (compound-type-form-p token)
+            :collect token :into compound-types
+    :else :if (and (null identifiers)
+                   (c-identifier-p token))
+            :collect token :into identifiers
+    :else
+      :collect token :into rest
+    :finally (return (values storage-classes
+                             type-qualifiers
+                             type-specifiers
+                             identifiers
+                             compound-types
+                             rest))))
+
+(defun validate-split-type (storage-classes type-qualifiers type-specifiers identifiers compound-types)
+  (declare (ignore type-qualifiers)) ; TODO
+  (let* ((thread-local (find '|thread-local| storage-classes))
+         (classes (remove thread-local storage-classes)))
+    (when (cdr classes)
+      (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                 :format-control "Only one storage class can be specified at once: ~A"
+                                 :format-arguments (list storage-classes)))
+    (when (and thread-local (set-difference classes '(|extern| |static|)))
+      (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                 :format-control "thread-local can only be specified with extern or static: ~A"
+                                 :format-arguments (list storage-classes))))
+  (when type-specifiers
+    (unless (validate-type type-specifiers)
+      (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                 :format-control "Invalid type specifier: ~A"
+                                 :format-arguments (list type-specifiers))))
+  (unless (or type-specifiers identifiers compound-types)
+    (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                               :format-control "No types specifier given"
+                               :format-arguments '()))
+  (when (or (and type-specifiers identifiers)
+            (and type-specifiers compound-types)
+            (and identifiers compound-types))
+    (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                               :format-control "Multiple types specified: ~@{~@[~{~A~^ ~}~^, ~]~}"
+                               :format-arguments (list type-specifiers identifiers compound-types)))
+  (when (cdr identifiers)
+    (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                               :format-control "Multiple types specified: ~{~A~^, ~}"
+                               :format-arguments (list identifiers)))
+  (when (cdr compound-types)
+    (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                               :format-control "Multiple compound types specified: ~{~A~^, ~}"
+                               :format-arguments (list identifiers))))
+
+(defun map-token (token map) (or (cdr (assoc token map)) token))
+
+(defun count-elements (list)
+  (let ((counts '()))
+    (dolist (element list (sort counts (function string<) :key (function car)))
+      (let ((entry (assoc element counts)))
+        (if (null entry)
+            (push (cons element 1) counts)
+            (incf (cdr entry)))))))
+
+(defun simple-type-equal-p (a b)
+  (equal (count-elements a) (count-elements b)))
+
+(defun validate-type (type)
+  (find-if (lambda (alternatives)
+             (find type alternatives :test (function simple-type-equal-p)))
+           *scalar-types*))
+
+;;----------------------------------------
+(defclass c-type (c-item)
+  ())
+
+(defclass c-named-type (c-type)
+  ((name            :initarg :name            :initform nil :reader c-type-name)
+   (storage-classes :initarg :storage-classes :initform '() :reader c-type-storage-classes)
+   (qualifiers      :initarg :qualifiers      :initform '() :reader c-type-qualifiers)))
+
+(defmethod generate ((item c-named-type))
+  (let ((storage-classes (c-type-storage-classes item))
+        (qualifiers      (c-type-qualifiers item))
+        (sep             ""))
+    (dolist (storage-class storage-classes)
+      (emit sep (map-token storage-class *storage-classes-map*))
+      (setf sep " "))
+    (dolist (qualifier qualifiers)
+      (emit sep (map-token qualifier *type-qualifiers-map*))
+      (setf sep " "))
+    (emit sep)))
+
+;;----------------------------------------
+(defclass c-simple-type (c-named-type)
+  ())
+
+(defun c-simple-type (name storage-classes qualifiers)
+  (make-instance 'c-simple-type :name name
+                                :storage-classes storage-classes
+                                :qualifiers qualifiers))
+
+(defmethod generate ((item c-simple-type))
+  (let ((name (c-type-name item)))
+    (when (null name)
+      (error 'linc-internal-error
+             :source-file *translate-linc-truename*
+             :format-control "A ~S such as ~S must not have a null name"
+             :format-arguments (list 'c-simple-type item)))
+    (call-next-method)
+    (if (atom name)
+        (generate name)
+        (let ((sep ""))
+          (dolist (item (c-type-name item))
+            (emit sep (map-token item *type-specifiers-map*))
+            (setf sep " "))))))
+
+;;----------------------------------------
+(defclass c-struct-union (c-named-type)
+  ((operator :initarg :operator :reader c-struct-union-operator)
+   (slots :initarg :slots :initform '()  :reader c-struct-union-slots)))
+
+(defun c-struct-union (name storage-classes qualifiers
+                       operator slots)
+  (make-instance 'c-struct-union :name name
+                                 :storage-classes storage-classes
+                                 :qualifiers qualifiers
+                                 :operator operator
+                                 :slots slots))
+
+(defmethod generate ((item c-struct-union))
+  (emit (c-struct-union-operator item))
+  (when (c-type-name item)
+    (emit " ")
+    (generate (c-type-name item)))
+  (when (c-struct-union-slots item)
+    (emit " ")
+    (with-parens "{}"
+      (dolist (slot (c-struct-union-slots item))
+        (generate slot)))))
+
+;;----------------------------------------
+(defclass c-slot (c-item)
+  ((name       :initarg :name                :reader c-slot-name)
+   (type       :initarg :type                :reader c-slot-type)
+   (bits       :initarg :bits  :initform nil :reader c-slot-bits)))
+
+(defun c-slot (name type bits)
+  (make-instance 'c-slot :name name :type type :bits bits))
+
+(defmethod generate ((item c-slot))
+  (emit :fresh-line)
+  (generate (c-slot-type item))
+  (emit " ")
+  (generate (c-slot-name item))
+  (let ((bits (c-slot-bits item)))
+    (when bits
+      (emit ":")
+      (generate bits)))
+  (emit ";" :newline))
+
+(defun parse-slot (slot)
+  (let* ((current        slot)
+         (name           (pop current))
+         (bits           (member-if (lambda (item)
+                                      (and (listp item)
+                                           (eql '|bit| (first item))))
+                                    current))
+         (type           (ldiff current bits))
+         (bit-field-size nil))
+    (when bits
+      (when (cdr bits)
+        (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                   :format-control "Invalid bit field size specifier ~S in slot ~S"
+                                   :format-arguments (list (first bits) slot)))
+      (setf bit-field-size (parse-expression (second (first bits)))))
+    (c-slot name (parse-type (ensure-type-list type)) bit-field-size)))
+
+
+;; types := void char short int long float double signed unsigned bool complex
+;;        | (struct …) | (enum …) | (union …) | (atomic …) | (pointer …) | (array …) | (function …)
+;;        | identifier
+
+#|
+
+(type (qualifiers…) (types…))
+(type (qualifiers…) identifier)
+
+(struct (qualifiers…) name slots…)
+(union (qualifiers…) name slots…)
+(enum name values…)
+
+(type (qualifiers…) (struct identifier))
+(type (qualifiers…) (struct [identifier] slots…))
+(type (qualifiers…) (struct [identifier] slots…))
+
+;; foo  (pointer const atomic unsigned int) -> (type const atomic unsigned int) ; (pointer foo)
+
+
+qualifier ::=
+
+const
+restrict
+volatile
+atomic
+
+(align-as type)
+(align-as size)
+
+
+type ::=
+
+identfier
+
+(atomic type)
+(struct name)
+(struct name slots…)
+(struct slots…)
+(union name)
+(union name slots…)
+(union slots…)
+(enum name)
+(enum name values…)
+(enum values…)
+
+
+(pointer qualifiers… type)
+(array qualifiers|static… type [static] [expression|*])
+(function ((identifer type) (type) ...) type
+
+(declare-function fname ((identifer type) (type) ...) type inline|noreturn…
+  (block …))
+
+
+slot ::=
+
+(name qualifiers… type [(bit size)])
+(qualifiers… type [(bit size)])
+
+|#
+
+
+(defun parse-struct-or-union-type (type)
+  ;; (struct|union [name] (slot)…)
+  (let ((operator (pop type))
+        (name (when (atom (first type))
+                (pop type))))
+    (when name (check-identifier name))
+    (c-struct-union name nil nil operator (mapcar (function parse-slot) type))))
+
+
+;;----------------------------------------
+(defclass c-enum (c-named-type)
+  ((values :initarg :values :initform '()  :reader c-enum-values)))
+
+(defun c-enum (name storage-classes qualifiers values)
+  (make-instance 'c-enum :name name
+                         :storage-classes storage-classes
+                         :qualifiers qualifiers
+                         :values values))
+
+(defmethod generate ((item c-enum))
+  (emit "enum")
+  (when (c-type-name item)
+    (emit " ")
+    (generate (c-type-name item)))
+  (when (c-enum-values item)
+    (emit " ")
+    (with-parens "{}"
+      (dolist (value (c-enum-values item))
+        (generate value)))))
+
+(defclass c-enum-value (c-item)
+  ((name :initarg :name :reader c-enum-value-name)
+   (value :initarg :value :initform nil :reader c-enum-value-value)))
+
+(defun c-enum-value (name value)
+  (make-instance 'c-enum-value :name name :value value))
+
+(defmethod generate ((item c-enum-value))
+  (emit :fresh-line)
+  (generate (c-enum-value-name item))
+  (when (c-enum-value-value item)
+    (emit "=")
+    (generate (c-enum-value-value item)))
+  (emit ",")
+  (emit :newline))
+
+(defun parse-enum-type         (form)
+  ;; (enum [name] [storage-classes|type-qualifiers]… constant-variable (constant-variable value-expression))
+  (let ((current form))
+    (pop current)
+    (let ((name (when (let ((item (first current)))
+                        (and (atom item)
+                             (not (or (member item *storage-classes*)
+                                      (member item *type-qualifiers*)))))
+                  (pop current))))
+      (when name
+        (check-identifier name))
+      (multiple-value-bind (storage-classes type-qualifiers values) (split-storage-classes-and-type-qualifiers current)
+        (c-enum name storage-classes type-qualifiers
+                (mapcar (lambda (value-form)
+                          (if (atom value-form)
+                              (progn
+                                (check-identifier value-form)
+                                (c-enum-value value-form nil))
+                              (let* ((current   value-form)
+                                     (name      (pop current))
+                                     (constexpr (pop current)))
+                                (when current
+                                  (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                             :format-control "Too many items in the enum value: ~S"
+                                                             :format-arguments (list value-form)))
+                                (check-identifier name)
+                                (c-enum-value name (parse-expression constexpr)))))
+                        values))))))
+
+;;;-------------------------------------------------------------------------------
+(defclass c-atomic (c-type)
+  ((type :initarg :type :reader c-atomic-type)))
+
+(defun c-atomic (type)
+  (make-instance 'c-atomic :type type))
+
+(defmethod generate ((item c-atomic))
+  (emit "_Atomic")
+  (with-parens "()" (generate (c-atomic-type item))))
+
+(defun parse-atomic-type       (form)
+  (let ((current form))
+    (pop current)
+    (c-atomic (parse-type current))))
+
+;;;-------------------------------------------------------------------------------
+(defclass c-pointer (c-type)
+  ((type            :initarg :type                          :reader c-pointer-type)
+   (qualifiers      :initarg :qualifiers      :initform '() :reader c-type-qualifiers)))
+
+(defun c-pointer (type qualifiers)
+  (make-instance 'c-pointer :type type :qualifiers qualifiers))
+
+(defmethod generate ((item c-pointer))
+  (generate (c-pointer-type item))
+  (emit " " "*")
+  (dolist (qualifier  (c-type-qualifiers item))
+    (emit " " (map-token qualifier *type-qualifiers-map*))))
+
+(defun parse-pointer-type      (form)
+  ;; (pointer qualifiers… type)
+  (let ((current form))
+    (pop current)
+    (multiple-value-bind (storage-classes type-qualifiers type-specifiers identifiers compound-types rest) (split-type current)
+      (validate-split-type storage-classes type-qualifiers type-specifiers identifiers compound-types)
+      (when rest
+        (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                   :format-control "Superfluous tokens after type: ~S"
+                                   :format-arguments (list rest)))
+      (unless (null storage-classes)
+        (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                   :format-control "Invalid storage class in pointer type: ~S"
+                                   :format-arguments (list form)))
+      (c-pointer (cond
+                   (type-specifiers (c-simple-type       type-specifiers        nil nil))
+                   (identifiers     (c-simple-type       (first identifiers)    nil nil))
+                   (compound-types  (parse-compound-type (first compound-types) nil nil)))
+                 type-qualifiers))))
+
+;;;-------------------------------------------------------------------------------
+(defclass c-array (c-type)
+  ((qualifiers      :initarg :qualifiers      :initform '() :reader c-type-qualifiers)
+   (storage-classes :initarg :storage-classes :initform '() :reader c-type-storage-classes)
+   (element-type    :initarg :element-type                  :reader c-array-element-type)
+   (element-count   :initarg :element-count   :initform nil :reader c-array-element-count)))
+
+(defun c-array (type-qualifiers storage-classes element-type element-count)
+  (make-instance 'c-array :qualifiers type-qualifiers
+                          :storage-classes storage-classes
+                          :element-type element-type
+                          :element-count element-count))
+
+(defmethod generate ((item c-array))
+  (generate (c-array-element-type item))
+  (with-parens "[]"
+    (let ((sep ""))
+      (dolist (storage-class (c-type-storage-classes item))
+        (emit sep (map-token storage-class *storage-classes-map*))
+        (setf sep " "))
+      (dolist (qualifier (c-type-qualifiers item))
+        (emit sep (map-token qualifier *type-qualifiers-map*))
+        (setf sep " "))
+      (when (c-array-element-count item)
+        (emit sep)
+        (generate (c-array-element-count item))))))
+
+(defun parse-array-type        (form)
+  ;; (array (type) qualifiers|static… [expression|*])
+  (let ((current form))
+    (pop current)
+    (let* ((type         (pop current))
+           (element-type (if (and type (or (symbolp type) (listp type)))
+                             (parse-type (ensure-type-list type))
+                             (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                        :format-control "Invalid element-type array type: ~S"
+                                                        :format-arguments (list type)))))
+      (multiple-value-bind (storage-classes type-qualifiers current) (split-storage-classes-and-type-qualifiers current)
+        (unless (or (null storage-classes)
+                    (equal storage-classes '(|static|)))
+          (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                     :format-control "Invalid storage class in array type: ~S"
+                                     :format-arguments (list storage-classes)))
+        (let ((element-count (cond
+                               ((null current)           nil)
+                               ((eql '* (first current)) (pop current))
+                               (t      (parse-expression (pop current))))))
+          (when current
+            (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                       :format-control "Invalid tokens in array type: ~S"
+                                       :format-arguments (list current)))
+          (c-array type-qualifiers storage-classes element-type element-count))))))
+
+;;;-------------------------------------------------------------------------------
+(defclass c-parameter (c-item)
+  ((name :initarg :name :initform nil :reader c-parameter-name)
+   (type :initarg :type :reader c-parameter-type)))
+
+(defun c-parameter (name type)
+  (make-instance 'c-parameter :name name :type type))
+
+(defmethod generate ((item c-parameter))
+  (generate (c-parameter-type item))
+  (when (c-parameter-name item)
+    (emit " ")
+    (generate (c-parameter-name item))))
+
+(defun parse-function-parameter (form)
+  ;; ([identifer] type)
+  (let ((name (first form)))
+    (if (and (not (null name))
+             (symbolp name)
+             (not (member name *storage-classes*))
+             (not (member name *type-qualifiers*))
+             (not (member name *type-specifiers*))
+             (not (null (second form))))
+        (c-parameter name (parse-type (rest form)))
+        (c-parameter nil  (parse-type form)))))
+
+;;;-------------------------------------------------------------------------------
+(defclass c-ftype (c-type)
+  ((parameters  :initarg :parameters  :reader c-ftype-parameters)
+   (result-type :initarg :result-type :reader c-ftype-result-type)))
+
+(defun c-ftype (parameters result-type)
+  (make-instance 'c-ftype :parameters parameters
+                          :result-type result-type))
+
+(defmethod generate ((item c-ftype))
+  (generate (c-ftype-result-type item))
+  (emit " ")
+  (with-parens "()"
+    (emit "*"))
+  (with-parens "()"
+    (let ((sep ""))
+      (dolist (parameter (c-ftype-parameters item))
+        (emit sep)
+        (generate parameter)
+        (setf sep ", ")))))
+
+(defun parse-function-signature (form)
+  ;; ((([identifer] type) |...|) type [inline|noreturn]… body…)
+  (check-type form list)
+  (let ((current form))
+    (unless (listp (first current))
+      (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                 :format-control "Invalid parameter list in function signature: ~S"
+                                 :format-arguments (list (first current))))
+    (let ((parameters (mapcar (lambda (parameter)
+                                (if (eql parameter '|...|)
+                                    parameter
+                                    (parse-function-parameter (if (atom parameter)
+                                                                  (list parameter)
+                                                                  parameter))))
+                              (pop current))))
+      (let ((ellipsis  (member '|...| parameters)))
+        (when  (rest ellipsis)
+          (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                     :format-control "Invalid parameter list in function signature; ellipsis must be last: ~S"
+                                     :format-arguments (list ellipsis))))
+      (unless current
+        (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                   :format-control "Missing return-type in signature signature: ~S"
+                                   :format-arguments (list form)))
+      (let* ((type        (pop current))
+             (return-type (parse-type (ensure-type-list type)))
+             (specifiers  (loop :while (function-specifier-p (first current))
+                                :collect (pop current) :into specifiers
+                                :finally (return (delete-duplicates specifiers))))
+             (body        (ensure-block current)))
+        (values parameters return-type specifiers body)))))
+
+(defun parse-function-type     (form)
+  ;; (function (([identifer] type) |...|) type)
+  (let ((current form))
+    (pop current)
+    (multiple-value-bind (parameters return-type specifiers body) (parse-function-signature current)
+      (when specifiers
+        (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                   :format-control "Unexpected function specifiers in function type declaration ~S"
+                                   :format-arguments (list specifiers)))
+      (when body
+        (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                   :format-control "Unexpected function body in function type declaration ~S"
+                                   :format-arguments (list body)))
+      (c-ftype parameters return-type))))
+
+;;;-------------------------------------------------------------------------------
+(defun parse-compound-type (form storage-class type-qualifiers)
+  ;; (struct …) | (enum …) | (union …) | (atomic …) | (pointer …) | (array …) | (function …)
+  (when (atom form)
+    (error 'linc-internal-error :source-form *source-form* :source-file *translate-linc-truename*
+                                :format-control "Invalid compound type: ~A"
+                                :format-arguments (list form)))
+  (when (or storage-class type-qualifiers)
+    (error 'linc-internal-error :source-form *source-form* :source-file *translate-linc-truename*
+                                :format-control "Compound type cannot take storage classes or type qualifiers for now: ~S ~S"
+                                :format-arguments (list storage-class type-qualifiers)))
+  (case (first form)
+    ((|struct| |union|) (parse-struct-or-union-type form))
+    ((|enum|)           (parse-enum-type            form))
+    ((|atomic|)         (parse-atomic-type          form))
+    ((|pointer|)        (parse-pointer-type         form))
+    ((|array|)          (parse-array-type           form))
+    ((|function|)       (parse-function-type        form))
+    (otherwise
+     (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                :format-control "Invalid compound type: ~A"
+                                :format-arguments (list form)))))
+
+(defun parse-type (type)
+  (multiple-value-bind (storage-classes type-qualifiers type-specifiers identifiers compound-types rest) (split-type type)
+    (validate-split-type storage-classes type-qualifiers type-specifiers identifiers compound-types)
+    (when rest
+      (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                 :format-control "Superfluous tokens after type: ~S"
+                                 :format-arguments (list rest)))
+    (cond
+      (type-specifiers (c-simple-type       type-specifiers        storage-classes type-qualifiers))
+      (identifiers     (c-simple-type       (first identifiers)    storage-classes type-qualifiers))
+      (compound-types  (parse-compound-type (first compound-types) storage-classes type-qualifiers)))))
+
+;;;---------------------------------------------------------------------
+(defclass c-declaration (c-item)
+  ((declared :initarg :declared :reader c-declaration-declared)))
+
+(defun c-declaration (declared)
+  (make-instance 'c-declaration :declared declared))
+
+(defmethod generate ((item c-declaration))
+  (emit :fresh-line)
+  (generate (c-declaration-declared item))
+  (emit ";" :newline))
+
+(defmethod ensure-statement ((item c-declaration))
+  item)
+
+;;;---------------------------------------------------------------------
+(defclass c-definition (c-item)
+  ((defined         :initarg :defined                     :reader c-definition-defined)
+   (needs-semicolon :initarg :needs-semicolon :initform t :reader c-definition-needs-semicolon-p)))
+
+(defun c-definition (defined &key (needs-semicolon t))
+  (make-instance 'c-definition :defined defined :needs-semicolon needs-semicolon))
+
+(defmethod generate ((item c-definition))
+  (emit :fresh-line)
+  (generate (c-definition-defined item))
+  (when (c-definition-needs-semicolon-p item)
+    (emit ";"))
+  (emit :newline))
+
+(defmethod ensure-statement ((item c-definition))
+  item)
+
+;;;---------------------------------------------------------------------
+(defclass c-typedef (c-item)
+  ((name :initarg :name :reader c-typedef-name)
+   (type :initarg :type :reader c-typedef-type)))
+
+(defun c-typedef (name type)
+  (check-type name symbol)
+  (check-type type c-type)
+  (make-instance 'c-typedef :name name :type type))
+
+(defmethod generate ((item c-typedef))
+  (emit "typedef" " ")
+  (generate (c-typedef-type item))
+  (emit " ")
+  (generate (c-typedef-name item)))
+
+(defun parse-declare-struct-or-union (operator form)
+  ;; (declare-structure name slots)
+  ;; (declare-union     name alternatives)
+  (let ((name-and-slots form))
+    (pop name-and-slots)
+    (let ((name (first name-and-slots)))
+      (check-identifier name))
+    (c-declaration (parse-struct-or-union-type `(,operator ,@name-and-slots)))))
+
+(defun parse-declare-structure (form)
+  ;; (declare-structure name slots)
+  (parse-declare-struct-or-union '|struct| form))
+
+(defun parse-declare-union       (form)
+  ;; (declare-union     name alternatives)
+  (parse-declare-struct-or-union '|union| form))
+
+(defun parse-declare-enumeration (form)
+  ;; (declare-enumeration name values)
+  (let ((name-and-values form))
+    (pop name-and-values)
+    (let ((name (first name-and-values)))
+      (check-identifier name))
+    (c-declaration (parse-enum-type `(|enum| ,@name-and-values)))))
+
+(defun parse-declare-type        (form)
+  ;; (declare-type      name type)
+  (let ((type form))
+    (pop type)
+    (let ((name (pop type)))
+      (check-identifier name)
+      (when (null type)
+        (error 'linc-program-error
+               :source-form *source-form* :source-file *translate-linc-truename*
+               :format-control "Missing type in declare-type form: ~S"
+               :format-arguments (list form)))
+      (c-declaration (c-typedef name (parse-type type))))))
+
+
+;;;---------------------------------------------------------------------
+(defclass c-constant (c-item)
+  ((name  :initarg :name                :reader c-constant-name)
+   (type  :initarg :type                :reader c-constant-type)
+   (value :initarg :value :initform nil :reader c-constant-value)))
+
+(defun c-constant (name type value)
+  (check-type name symbol)
+  (check-type type c-type)
+  (check-type value (or null c-expression))
+  (make-instance 'c-constant :name name :type type :value value))
+
+(defmethod generate ((item c-constant))
+  (emit "const" " ")
+  (generate (c-constant-type item))
+  (emit " ")
+  (generate (c-constant-name item))
+  (when (c-constant-value item)
+    (emit " " "=" " ")
+    (generate (c-constant-value item))))
+
+(defun parse-declare-constant    (form)
+  ;; (declare-constant      name type)
+  (let ((current form))
+    (pop current)
+    (let ((name (pop current)))
+      (check-identifier name)
+      (when (null current)
+        (error 'linc-program-error
+               :source-form *source-form* :source-file *translate-linc-truename*
+               :format-control "Missing type in declare-constant form: ~S"
+               :format-arguments (list form)))
+      (let ((type (pop current)))
+        (when current
+          (error 'linc-program-error
+                 :source-form *source-form* :source-file *translate-linc-truename*
+                 :format-control "Superfluous tokens define-constant form: ~S"
+                 :format-arguments (list form))))
+      (c-declaration (c-constant name
+                                 (parse-type (if (listp type)
+                                                 type
+                                                 (list type)))
+                                 nil)))))
+
+(defun parse-define-constant    (form)
+  ;; (define-constant      name type value)
+  (let ((current form))
+    (pop current)
+    (let ((name (pop current)))
+      (check-identifier name)
+      (when (null current)
+        (error 'linc-program-error
+               :source-form *source-form* :source-file *translate-linc-truename*
+               :format-control "Missing type in define-constant form: ~S"
+               :format-arguments (list form)))
+      (let ((type (pop current)))
+        (when (null current)
+          (error 'linc-program-error
+                 :source-form *source-form* :source-file *translate-linc-truename*
+                 :format-control "Missing value in define-constant form: ~S"
+                 :format-arguments (list form)))
+        (let ((value (pop current)))
+          (c-definition (c-constant name (parse-type type) (parse-expression value))))))))
+
+;;;---------------------------------------------------------------------
+(defclass c-variable (c-expression)
+  ((name  :initarg :name                :reader c-variable-name)
+   (type  :initarg :type                :reader c-variable-type)
+   (value :initarg :value :initform nil :reader c-variable-value)))
+
+(defun c-variable (name type value)
+  (check-type name symbol)
+  (check-type type c-type)
+  (check-type value (or null c-expression))
+  (make-instance 'c-variable :name name :type type :value value))
+
+(defmethod generate ((item c-variable))
+  (generate (c-variable-type item))
+  (emit " ")
+  (generate (c-variable-name item))
+  (when (c-variable-value item)
+    (emit " " "=" " ")
+    (generate (c-variable-value item))))
+
+(defun parse-declare-variable    (form)
+  ;; (declare-variable      name type)
+  (let ((type form))
+    (pop type)
+    (let ((name (pop type)))
+      (check-identifier name)
+      (when (null type)
+        (error 'linc-program-error
+               :source-form *source-form* :source-file *translate-linc-truename*
+               :format-control "Missing type in declare-variable form: ~S"
+               :format-arguments (list form)))
+      (c-declaration (c-variable name (parse-type type) nil)))))
+
+(defun parse-define-variable    (form)
+  ;; (define-variable      name type value)
+  (let ((current form))
+    (pop current)
+    (let ((name (pop current)))
+      (check-identifier name)
+      (when (null current)
+        (error 'linc-program-error
+               :source-form *source-form* :source-file *translate-linc-truename*
+               :format-control "Missing type in define-variable form: ~S"
+               :format-arguments (list form)))
+      (let ((type (pop current)))
+        (when (null current)
+          (error 'linc-program-error
+                 :source-form *source-form* :source-file *translate-linc-truename*
+                 :format-control "Missing value in define-variable form: ~S"
+                 :format-arguments (list form)))
+        (let ((value (pop current)))
+          (c-definition (c-variable name (parse-type (ensure-type-list type)) (parse-expression value))))))))
+
+
+;;;---------------------------------------------------------------------
+(defclass c-function (c-item)
+  ((name        :initarg :name        :reader c-function-name)
+   (parameters  :initarg :parameters  :reader c-function-parameters)
+   (result-type :initarg :result-type :reader c-function-result-type)
+   (specifiers  :initarg :specifiers  :reader c-function-specifiers  :initform nil)
+   (body        :initarg :body        :reader c-function-body        :initform nil)))
+
+(defun c-function (name parameters result-type specifiers body)
+  (check-type name symbol)
+  (check-type parameters list)
+  (assert (every (lambda (item) (cl:typep item 'c-parameter)) parameters) (parameters))
+  (check-type result-type c-type)
+  (check-type specifiers list)
+  (check-type body (or null c-statement))
+  (make-instance 'c-function :name name
+                             :parameters parameters
+                             :result-type result-type
+                             :specifiers specifiers
+                             :body body))
+
+(defmethod generate ((item c-function))
+  (emit :fresh-line)
+  (let ((sep ""))
+    (dolist (specifier  (c-function-specifiers item))
+      (emit sep)
+      (generate specifier)
+      (setf sep " "))
+    (emit sep)
+    (generate (c-function-result-type item)))
+  (emit " ")
+  (generate (c-function-name item))
+  (with-parens "()"
+    (let ((sep ""))
+      (dolist (parameter (c-function-parameters item))
+        (emit sep)
+        (generate parameter)
+        (setf sep ", "))))
+  (when (c-function-body item)
+    (emit :newline)
+    (generate (c-function-body item))
+    (emit :newline)))
+
+(defun parse-declare-function    (form)
+  ;; (declare-function    name lambda-list type [inline] [noreturn])
+  (let ((current form))
+    (pop current)
+    (let ((name (pop current)))
+      (check-identifier name)
+      (multiple-value-bind (parameters return-type specifiers body) (parse-function-signature current)
+        (when body
+          (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                     :format-control "Unexpected function body in function declaration ~S"
+                                     :format-arguments (list body)))
+        (c-declaration (c-function name parameters return-type specifiers nil))))))
+
+(defun parse-define-function    (form)
+  ;; (define-function     name lambda-list type [inline] [noreturn] &body body)
+  (let ((current form))
+    (pop current)
+    (let ((name (pop current)))
+      (check-identifier name)
+      (multiple-value-bind (parameters return-type specifiers body) (parse-function-signature current)
+        (unless body
+          (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                     :format-control "Missing function body in function definition ~S"
+                                     :format-arguments (list form)))
+        (c-definition (c-function name parameters return-type specifiers body)
+                      :needs-semicolon nil)))))
+
+;;;---------------------------------------------------------------------
+(defclass c-macro (c-item)
+  ((name        :initarg :name        :reader c-macro-name)
+   (parameters  :initarg :parameters  :reader c-macro-parameters   :initform nil)
+   (expansion   :initarg :expansion   :reader c-macro-expansion)))
+
+(defun c-macro (name parameters expansion)
+  (check-type name symbol)
+  (check-type parameters list)
+  (check-type expansion string)
+  (make-instance 'c-macro :name name
+                          :parameters parameters
+                          :expansion expansion))
+
+(defmethod generate ((item c-macro))
+  (emit :fresh-line "#define" " ")
+  (generate (c-macro-name item))
+  (when (c-macro-parameters item)
+    (with-parens "()"
+      (let ((sep ""))
+        (dolist (parameter (c-macro-parameters item))
+          (emit sep)
+          (generate parameter)
+          (setf sep ", ")))))
+  (emit " ")
+  (emit (c-macro-expansion item))
+  (emit :newline))
+
+
+(defun parse-define-macro        (form)
+  ;; (define-macro        name [lambda-list] expansion-string)
+  (let ((current form))
+    (pop current)
+    (let ((name (pop current)))
+      (check-identifier name)
+      (flet ((check-eof (current)
+               (when current
+                 (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                            :format-control "Superfluous tokens after macro expansion: ~S"
+                                            :format-arguments (list current))))
+             (check-expansion (expansion)
+               (unless (stringp expansion)
+                 (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                            :format-control "A C macro expansion must be a string, not ~S"
+                                            :format-arguments (list expansion)))))
+        (if (listp (first current))
+            (let ((parameters (pop current))
+                  (expansion  (pop current)))
+              (check-eof current)
+              (check-expansion expansion)
+              (dolist (parameter parameters)
+                (check-identifier parameter))
+              (c-definition (c-macro name parameters expansion) :needs-semicolon nil))
+            (let ((expansion (pop current)))
+              (check-eof current)
+              (check-expansion expansion)
+              (c-definition (c-macro name nil expansion) :needs-semicolon nil)))))))
+
+;;;---------------------------------------------------------------------
+
+
+(defun parse-expression (expression)
+  (if (atom expression)
+      (if (symbolp expression)
+          (c-varref expression)
+          (c-literal expression))
+      (let* ((operator  (first expression))
+             (arguments (if (member operator '(com.informatimago.languages.linc.c:|cast|))
+                            (rest expression)
+                            (mapcar (function parse-expression) (rest expression)))))
+        (flet ((op-or-call ()
+                 (cond
+                   ((c-operator-p operator)
+                    (apply operator arguments))
+                   ((symbolp      operator)
+                    (apply (function expr-call) operator arguments))
+                   (t (error 'linc-program-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                 :format-control "Invalid operator ~S in expression ~S"
+                                                 :format-arguments (list operator expression))))))
+          (case operator
+            ((com.informatimago.languages.linc.c:+)
+             (if (= 1 (length arguments))
+                 (expr-pos (first arguments))
+                 (op-or-call)))
+            ((com.informatimago.languages.linc.c:-)
+             (if (= 1 (length arguments))
+                 (expr-neg (first arguments))
+                 (op-or-call)))
+            ((com.informatimago.languages.linc.c:*)
+             (if (= 1 (length arguments))
+                 (expr-deref (first arguments))
+                 (op-or-call)))
+            ((com.informatimago.languages.linc.c:&)
+             (if (= 1 (length arguments))
+                 (expr-address (first arguments))
+                 (op-or-call)))
+            ((com.informatimago.languages.linc.c:|::|)
+             (apply (if (= 1 (length arguments))
+                        (function absolute-scope)
+                        (function expr-scope))
+                    arguments))
+            ((com.informatimago.languages.linc.c:|cast|)
+             (expr-cast (parse-expression (first arguments)) (parse-type (rest arguments))))
+            ((com.informatimago.languages.linc.c:|post--|)
+             (expr-postdecr (first arguments)))
+            ((com.informatimago.languages.linc.c:|post++|)
+             (expr-postincr (first arguments)))
+            (otherwise
+             (op-or-call)))))))
+
+
+;; (enable-c-sexp-reader-macros)
+;; (parse-expression (first '{ (= a (? (== a (cast 0 int)) 1 (+ a (* b (- c d))))) }))
+;; (parse-expression (first '{ (cast (+ 1 41) unsigned int) }))
+
+(defun ensure-block (forms)
+  ;; ((print 'hi))
+  ;; ((print 'hi) (print 'lo))
+  ;; ((|block| (print 'hi) (print 'lo)))
+  (cond
+    ((null forms)
+     nil)
+    ((and (= 1 (length forms))
+          (listp (first forms))
+          (member (first (first forms)) '(|block| |let| |let*|)))
+     (parse-statement (first forms)))
+    (t
+     (parse-statement `(|block| ,@forms)))))
+
+(defvar *linc-macros* (make-hash-table))
+
+(defun linc-macro-p (name)
+  (gethash name *linc-macros*))
+
+(defun linc-macroexpand (form)
+  (funcall (or (gethash (first form) *linc-macros*)
+               (error "Not a linc macro ~S" (first form)))
+           form))
+
+(defmacro define-linc-macro (name (&rest lambda-list) &body body)
+  (let ((whole (gensym)))
+    `(progn
+       (setf (gethash ',name *linc-macros*)
+            (lambda (,whole) (destructuring-bind (,@lambda-list) (rest ,whole)
+                               (block ,name ,@body))))
+       ',name)))
+
+(define-linc-macro |let| ((&rest bindings) &body body)
+  (let ((temps (mapcar (lambda (binding) (gentemp (format nil "temp-~(~A~)" (first binding)) *c-package-name*))
+                       bindings)))
+    `(|block|
+         ,@(mapcar (lambda (temp binding)
+                     `(|define-variable| ,temp ,@(rest binding)))
+                   temps bindings)
+       ,@(mapcar (lambda (temp binding) `(|define-variable| ,@(subseq binding 0 2) ,temp))
+                 temps bindings)
+       ,@body)))
+
+(define-linc-macro |let*| ((&rest bindings) &body body)
+  `(|block|
+     ,@(mapcar (lambda (binding) `(|define-variable| ,@binding))
+               bindings)
+     ,@body))
+
+
+;; (pprint (linc-macroexpand (first '{(let* ((a int 42) (b int (+ a 2))) (print a b))})))
+;; --> (|block|
+;;      (|define-variable| COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C::\a |int| 42)
+;;      (|define-variable| COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C::\b |int| (COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C:+ COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C::\a 2))
+;;      (COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C::|print| COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C::\a COM\.INFORMATIMAGO\.LANGUAGES\.LINC\.C::\b))
+
+
+
+
+(define-linc-macro |cond| (&rest clauses)
+  (case (length clauses)
+    (0 `(block))
+    (1 `(if ,(first (first clauses))
+            (block ,@(rest (first clauses)))))
+    (otherwise )))
+
+
+(defun parse-statement (form)
+  (if (atom form)
+      (stmt-expr (parse-expression form))
+      (case (first form)
+        ;; 0-ary
+        ((|break|)     (stmt-break))
+        ((|continue|)  (stmt-continue))
+        ;; 1-ary
+        ((|label|)     (stmt-label (c-identifier (second form))))
+        ((|goto|)      (stmt-goto  (c-identifier (second form))))
+        ;; ((asm)       (stmt-asm  (second form)))
+        ;; 0/1-ary
+        ((|return|)    (if (rest form)
+                           (stmt-return (parse-expression (second form)))
+                           (stmt-return)))
+
+        ;; any-ary
+        ((|block|)     (stmt-block (mapcar (function parse-statement) (rest form))))
+        ((|while|)     (stmt-while (ensure-block (rest (rest form)))
+                                   (parse-expression (second form))))
+        ((|do|)        (let ((while (last form 2))
+                             (body  (butlast (rest form) 2)))
+                         (unless (eql '|while| (first while))
+                           (error "syntax error in (do … while test)"))
+                         (stmt-do (ensure-block body)
+                                  (parse-expression (second while)))))
+        ((|case|)     (stmt-case  (parse-expression (second form))
+                                  (ensure-block (rest (rest form)))))
+        ((|default|)  (stmt-default (ensure-block (rest (rest form)))))
+        ;; syntax
+        ((|if|)       (destructuring-bind (if test then &optional else) form
+                        (stmt-if (parse-statement then)
+                                 (when else (parse-statement else))
+                                 (parse-expression test))))
+        ((|for|)      (destructuring-bind (for (init test step) &body body) form
+                        (stmt-for (parse-expression init) ; TODO declarator!!!
+                                  (parse-expression test)
+                                  (parse-expression step)
+                                  (ensure-block body))))
+        ((|switch|)   (destructuring-bind (switch expression &body body) form
+                        (stmt-switch (ensure-block body) (parse-expression expression))))
+        ;; local declarations or definitions (all but function definitions):
+        ((|declare-structure|)   (parse-declare-structure   form))
+        ((|declare-union|)       (parse-declare-union       form))
+        ((|declare-type|)        (parse-declare-type        form))
+        ((|declare-enumeration|) (parse-declare-enumeration form))
+        ((|declare-constant|)    (parse-declare-constant    form))
+        ((|declare-variable|)    (parse-declare-variable    form))
+        ((|declare-function|)    (parse-declare-function    form))
+        ((|define-constant|)     (parse-define-constant     form))
+        ((|define-variable|)     (parse-define-variable     form))
+        ((|define-macro|)        (parse-define-macro        form))
+        ;; macros or function calls:
+        (otherwise
+         (if (linc-macro-p (first form))
+             (parse-statement (linc-macroexpand form))
+             (stmt-expr (parse-expression form)))))))
+
+;;;---------------------------------------------------------------------
+
+(defun parse-linc-form (form)
+  (cond
+    ((stringp form) (c-comment form))
+    ((atom form)    (error 'linc-stray-atom-error :source-form *source-form* :source-file *translate-linc-truename*
+                                                  :format-control "Stray atom in C-sexp source: ~S; ignored."
+                                                  :format-arguments (list form)))
+    (t (let ((op (first form)))
+         (case op
+           ((|include|)             (parse-include form))
+           ((|#ifdef|)              (parse-ifdef   form))
+           ((|#ifndef|)             (parse-ifndef  form))
+           ((|#if|)                 (parse-if      form))
+           ((|declare-structure|)   (parse-declare-structure   form))
+           ((|declare-union|)       (parse-declare-union       form))
+           ((|declare-type|)        (parse-declare-type        form))
+           ((|declare-enumeration|) (parse-declare-enumeration form))
+           ((|declare-constant|)    (parse-declare-constant    form))
+           ((|declare-variable|)    (parse-declare-variable    form))
+           ((|declare-function|)    (parse-declare-function    form))
+           ((|define-constant|)     (parse-define-constant     form))
+           ((|define-variable|)     (parse-define-variable     form))
+           ((|define-function|)     (parse-define-function     form))
+           ((|define-macro|)        (parse-define-macro        form))
+           (otherwise
+            (error 'linc-invalid-operator-error :source-form *source-form*
+                                                :source-file *translate-linc-truename*
+                                                :format-control "Invalid operator: ~S"
+                                                :format-arguments (list op))))))))
+
+(defun translate-linc-form (*source-form*)
+  (let ((item (parse-linc-form *source-form*)))
+    (with-output-to-string (*c-out*)
+      (generate item))))
+
+(defun translate-linc-file (input-file &key output-file
+                                         (verbose *translate-linc-verbose*)
+                                         (print   *translate-linc-print*)
+                                         (external-format :default))
+  (with-open-file (input input-file :external-format external-format)
+    (with-open-file (output (or output-file (make-pathname :type "c" :case :local :defaults input-file))
+                            :direction :output
+                            :external-format external-format
+                            :if-does-not-exist :create
+                            :if-exists :supersede)
+      (write-line    "/* ------------------------- DO NOT EDIT! --------------------------------- */" output)
+      (write-line    "/* WARNING: This file is generated automatically by LINC from the source    */" output)
+      (let ((name (namestring input-file)))
+        (format output "/* file ~VA */~%" (- 78 3 5 3) name))
+      (write-line    "/* ------------------------- DO NOT EDIT! --------------------------------- */" output)
+      (terpri output)
+      (let ((temp-package  (let ((*package* *package*))
+                             (com.informatimago.common-lisp.interactive.interactive:mkupack
+                              :name (format nil "com.informatimago.languages.linc.c.~(~A~)." (file-namestring input))
+                              :use '("COM.INFORMATIMAGO.LANGUAGES.LINC.C")))))
+        (unwind-protect
+             (let ((*package*         temp-package)
+                   (*readtable*       (copy-readtable com.informatimago.languages.linc::*c-readtable*))
+                   (*translate-linc-verbose*  verbose)
+                   (*translate-linc-print*    print)
+                   (*translate-linc-pathname* (pathname input))
+                   (*translate-linc-truename* (truename input))
+                   (warnings-p        nil)
+                   (failures-p        nil))
+               (handler-bind ((warning       (lambda (condition)
+                                               (declare (ignore condition))
+                                               (if warnings-p
+                                                   (incf warnings-p)
+                                                   (setf warnings-p 1))
+                                               nil))
+                              (style-warning (lambda (condition)
+                                               (declare (ignore condition))
+                                               nil))
+                              (linc-error    (lambda (condition)
+                                               (if failures-p
+                                                   (incf failures-p)
+                                                   (setf failures-p 1))
+                                               (format *error-output* "~&ERROR: ~{~A~%~^       ~}"
+                                                       (split-sequence #\newline (princ-to-string condition)))
+                                               (finish-output *error-output*)
+                                               (invoke-restart (find-restart 'continue-translation condition)))))
+                 (loop
+                   :for form := (read input nil input)
+                   :until (eql form input)
+                   :do (when print
+                         (let ((*print-pretty* t)
+                               (*print-right-margin* 120))
+                           (format t "~&~S~%" form)))
+                       (with-simple-restart (continue-translation "Continue Translation")
+                         (let ((code (translate-linc-form form)))
+                           (when verbose
+                             (format t "~&~{;;    ~A~%~}" (split-sequence #\newline code)))
+                           (write-string code output)))
+                   :finally (return (values (truename output) warnings-p failures-p)))))
+          (delete-package temp-package))))))
+
+;;;; THE END ;;;;
diff --git a/languages/linc/c-string-reader.lisp b/languages/linc/c-string-reader.lisp
new file mode 100644
index 0000000..d7813f0
--- /dev/null
+++ b/languages/linc/c-string-reader.lisp
@@ -0,0 +1,199 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               c-string-reader.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    A C string reader, implementing C string back-slash escapes.
+;;;;    Also includes a writer to print strings with C back-slash escapes.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2013-05-22 <PJB> Added character-code-reader-macro, factorized
+;;;;                     out c-escaped-character-map.
+;;;;                     Published as http://paste.lisp.org/display/137262
+;;;;    2011-05-21 <PJB> Updated from http://paste.lisp.org/display/69905 (lost).
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2013 - 2013
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(defun c-escaped-character-map (escaped-character)
+  (case escaped-character
+    ((#\' #\" #\? #\\) escaped-character)
+    ((#\newline) -1)
+    ((#\a)        7)
+    ((#\b)        8)
+    ((#\t)        9)
+    ((#\n)       10)
+    ((#\v)       11)
+    ((#\f)       12)
+    ((#\r)       13)
+    ((#\x)       :hexa)
+    ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7) :octal)
+    (otherwise   :default)))
+
+(defun char-unicode (character)
+  (let ((bytes (babel:string-to-octets (string character)
+                                       :encoding :utf-32be
+                                       :use-bom nil)))
+    (+ (* 256 (+ (* 256 (+ (* 256 (aref bytes 0))
+                           (aref bytes 1)))
+                 (aref bytes 2)))
+       (aref bytes 3))))
+
+(defun character-code-reader-macro (stream quotation-mark)
+  (declare (ignore quotation-mark))
+  (flet ((encode (ch) (char-unicode ch)))
+    (let ((ch (read-char stream)))
+      (if (char/= #\\ ch)
+          (encode ch)
+          (let* ((ch (read-char stream))
+                 (code (c-escaped-character-map ch)))
+            (flet ((read-code (*read-base* base-name)
+                     (let ((code (read stream)))
+                       (if (and (integerp code) (<= 0 code (1- char-code-limit)))
+                           code
+                           (error "Invalid ~A character code: ~A" base-name code)))))
+              (case code
+                (:hexa  (read-code 16 "hexadecimal"))
+                (:octal (unread-char ch stream) (read-code  8 "octal"))
+                (:default ;; In emacs ?\x = ?x
+                 (encode ch))
+                (otherwise
+                 (if (characterp code)
+                     (encode code)
+                     code)))))))))
+
+(defun read-c-string (stream char)
+  "Read a C string from the STREAM
+The initial double-quote must have been read already."
+  (declare (ignore char))
+  (let ((buffer (make-array 80 :element-type 'character
+                            :adjustable t :fill-pointer 0))
+        (state :in-string)
+        (start  0))
+    (flet ((process-token (ch)
+             (ecase state
+               ((:in-string)
+                (setf state (case ch
+                              ((#\")     :out)
+                              ((#\\)     :escape)
+                              (otherwise (vector-push-extend ch buffer)
+                                         :in-string)))
+                nil)
+               ((:escape)
+                (setf state :in-string)
+                (let ((code (c-escaped-character-map ch)))
+                  (case code
+                    (:hexa
+                     (setf state :in-hexa
+                           start (fill-pointer buffer)))
+                    (:octal
+                     (setf state :in-octal
+                           start (fill-pointer buffer))
+                     (vector-push-extend ch buffer))
+                    (:default
+                     (error "Invalid escape character \\~C at position ~D"
+                            ch (fill-pointer buffer)))
+                    (otherwise
+                     (cond
+                       ((characterp code) (vector-push-extend code buffer))
+                       ((eql -1 code) #|remove it|#)
+                       (t (vector-push-extend (aref #(- - - - - - -
+                                                      #\bell #\backspace #\tab
+                                                      #\linefeed #\vt #\page
+                                                      #\return)
+                                                    code)
+                                              buffer))))))
+                nil)
+               ((:in-octal)
+                (flet ((insert-octal ()
+                         (setf (aref buffer start) (code-char (parse-integer buffer :start start :radix 8))
+                               (fill-pointer buffer) (1+ start)
+                               state :in-string)))
+                 (case ch
+                   ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
+                    (vector-push-extend ch buffer)
+                    (when (<= 3 (- (fill-pointer buffer) start))
+                      (insert-octal))
+                    nil)
+                   (otherwise
+                    (insert-octal)
+                    :again))))
+               ((:in-hexa)
+                (case ch
+                  ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+                        #\a #\b #\c #\d #\e #\f
+                        #\A #\B #\C #\D #\E #\F)
+                   (vector-push-extend ch buffer)
+                   nil)
+                  (otherwise
+                   (if (< start (fill-pointer buffer))
+                       (setf (aref buffer start) (code-char (parse-integer buffer :start start :radix 16))
+                             (fill-pointer buffer) (1+ start))
+                       (error "Invalid hexadecimal digit at position ~A" (fill-pointer buffer)))
+                   (setf state :in-string)
+                   :again))))))
+      (loop
+         :for ch = (read-char stream)
+         :do (loop :while (process-token ch))
+         :until (eq state :out)
+         :finally (return buffer)))))
+
+(defun write-c-string (string &optional (stream *standard-output*))
+  "Prints the string as a C string, with C escape sequences."
+  (loop
+     :for ch :across string
+     :initially (princ "\"" stream)
+     :do (princ (case ch
+                  ((#\bell)               "\\a")
+                  ((#\backspace)          "\\b")
+                  ((#\page)               "\\f")
+                  ((#\newline
+                    #-#.(cl:if (cl:char= #\newline #\linefeed) '(:and) '(:or))
+                    #\linefeed) "\\n")
+                  ((#\return)             "\\r")
+                  ((#\tab)                "\\t")
+                  ((#\vt)                 "\\v")
+                  ((#\")                  "\\\"")
+                  ((#\\)                  "\\\\")
+                  (otherwise
+                   (if (< (char-code ch) 32)
+                       (format nil "\\~3,'0o" (char-code ch))
+                       ch)))
+                stream)
+     :finally (princ "\"" stream)))
+
+(defun test/read-c-string ()
+ (let ((*readtable*
+        (let ((rt (copy-readtable nil)))
+          (set-macro-character #\" (function read-c-string) nil rt)
+          rt)))
+    (read-from-string "\"Hello, bell=\\a, backspace=\\b, page=\\f, newline=\\n, return=\\r, tab=\\t, vt=\\v, \\
+\\\"double-quotes\\\", \\'single-quotes\\', question\\?, backslash=\\\\, \\
+hexa=\\x3BB, octal=\\101, \\7\\77\\107\\3071\"")))
+
+;;;; THE END ;;;;
diff --git a/languages/linc/c-syntax-test.lisp b/languages/linc/c-syntax-test.lisp
new file mode 100644
index 0000000..e390abe
--- /dev/null
+++ b/languages/linc/c-syntax-test.lisp
@@ -0,0 +1,353 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(assert (equal (camel-case (symbol-name 'com.informatimago.languages.linc.c::my-var)
+                           :capitalize-initial nil)
+               "myVar"))
+
+(defmacro check-emited (form expected)
+  `(let ((result (with-output-to-string (*c-out*) ,form)))
+     (assert (equal result ,expected)
+             ()
+             "Evaluating ~S~% returned   ~S~% instead of ~S"
+             ',form result ,expected)))
+
+(defmacro check-item-and-emited (form expected)
+  `(progn
+     ;; TODO: implement an equal method on c-item
+     (assert (equal (read-from-string (prin1-to-string ,form))
+                    (read-from-string (prin1-to-string (eval ',form)))))
+     (check-emited (generate ,form) ,expected)))
+
+(check-emited (emit (camel-case (symbol-name 'com.informatimago.languages.linc.c::printf)
+                                :capitalize-initial nil))
+              "printf")
+
+(check-emited (generate 'com.informatimago.languages.linc.c::my-var)
+              "myVar")
+
+(assert (equal (c-sexp 'com.informatimago.languages.linc.c::my-var)
+               ''com.informatimago.languages.linc.c::my-var))
+
+(check-emited (generate "hello world\\r")
+              "\"hello world\\r\"")
+
+(check-emited
+ (dolist (x (list 0 -1 1 -128 127 128
+                  -32768 32767 32768
+                  (- (expt 2 31)) (1- (expt 2 31)) (expt 2 31)
+                  (- (expt 2 32)) (1- (expt 2 32)) (expt 2 32)
+                  (- (expt 2 63)) (1- (expt 2 63)) (expt 2 63)
+                  (- (expt 2 64)) (1- (expt 2 64)) (expt 2 64)
+                  (- (expt 2 127)) (1- (expt 2 127)) (expt 2 127)
+                  (- (expt 2 128)) (1- (expt 2 128)) (expt 2 128)))
+   (block go-on
+     (handler-bind ((error (lambda (err)
+                             (declare (ignore err))
+                             ;; (princ err) (terpri)
+                             (return-from go-on))))
+       (generate x)))
+   (emit ", "))
+ "0, -1, 1, -128, 127, 128, -32768, 32767, 32768, -2147483648, 2147483647, 2147483648L, -4294967296L, 4294967295L, 4294967296L, -9223372036854775808L, 9223372036854775807L, 9223372036854775808L, -18446744073709551616L, 18446744073709551615L, 18446744073709551616L, -170141183460469231731687303715884105728LL, 170141183460469231731687303715884105727LL, 170141183460469231731687303715884105728LL, -340282366920938463463374607431768211456LL, 340282366920938463463374607431768211455LL, , ")
+
+
+(check-emited (generate pi)
+              "3.141592653589793E+0")
+
+(check-emited (generate (coerce pi 'short-float))
+              "3.1415927E+0F")
+
+(check-emited (generate (coerce (expt pi 130) 'long-float))
+              "4.260724468298572E+64")
+
+(check-emited (generate 123.456l89)
+              "1.23456E+91")
+
+(check-emited (generate #\a)
+              "'a'")
+
+(check-emited (generate #\newline)
+              "'\\12'")
+
+(check-item-and-emited (expr-seq (assign 'a 1) (assign 'b 2) (assign 'c 3)) "a=1,b=2,c=3")
+
+(check-item-and-emited (expr-callargs (assign 'a 1) (assign 'b 2) (assign 'c 3)) "a=1,b=2,c=3")
+
+(check-item-and-emited (expr-callargs (expr-seq (assign 'a 1) (assign 'b 2) (assign 'c 3))) "a=1,b=2,c=3")
+;; TODO: expr-args above expr-seq to force parens in: fun(arg,(f(a),g(b)),arg);
+
+(check-item-and-emited (expr-callargs (assign 'a 1) (expr-seq (assign 'b 2) (assign 'c 3))) "a=1,b=2,c=3")
+
+(check-item-and-emited (expr-if (expr-eq 'a 1) 2 3) "a==1?2:3")
+
+(check-item-and-emited (assign 'var 42) "var=42")
+
+(check-item-and-emited (assign-times 'var 42) "var*=42")
+
+(check-item-and-emited (assign-divided 'var 42) "var/=42")
+
+(check-item-and-emited (assign-modulo 'var 42) "var%=42")
+
+(check-item-and-emited (assign-plus 'var 42) "var+=42")
+
+(check-item-and-emited (assign-minus 'var 42) "var-=42")
+
+(check-item-and-emited (assign-right-shift 'var 42) "var>>=42")
+
+(check-item-and-emited (assign-left-shift 'var 42) "var<<=42")
+
+(check-item-and-emited (assign-bitand 'var 42) "var&=42")
+
+(check-item-and-emited (assign-bitor 'var 42) "var|=42")
+
+(check-item-and-emited (assign-bitxor 'var 42) "var^=42")
+
+(check-item-and-emited (expr-logor (expr-eq 'p 0) (expr-ne 'q 0)) "p==0||q!=0")
+
+(check-item-and-emited (expr-logand (expr-eq 'p 0) (expr-ne 'q 0)) "p==0&&q!=0")
+
+(check-item-and-emited (expr-bitor (expr-eq 'p 0) (expr-ne 'q 0)) "p==0|q!=0")
+
+(check-item-and-emited (expr-bitxor (expr-eq 'p 0) (expr-ne 'q 0)) "p==0^q!=0")
+
+(check-item-and-emited (expr-bitand (expr-eq 'p 0) (expr-ne 'q 0)) "p==0&q!=0")
+
+(check-item-and-emited (expr-eq 'p 0) "p==0")
+
+(check-item-and-emited (expr-ne 'p 0) "p!=0")
+
+(check-item-and-emited (expr-lt 'p 'q) "p<q")
+
+(check-item-and-emited (expr-le 'p 'q) "p<=q")
+
+(check-item-and-emited (expr-gt 'p 'q) "p>q")
+
+(check-item-and-emited (expr-ge 'p 'q) "p>=q")
+
+(check-item-and-emited (expr-left-shift 'var 42) "var<<42")
+
+(check-item-and-emited (expr-right-shift 'var 42) "var>>42")
+
+(check-item-and-emited (expr-plus 'a 'b) "a+b")
+
+(check-item-and-emited (expr-minus 'a 'b) "a-b")
+
+(check-item-and-emited (expr-times 'a 'b) "a*b")
+
+(check-item-and-emited (expr-divided 'a 'b) "a/b")
+
+(check-item-and-emited (expr-modulo 'a 'b) "a%b")
+
+(check-item-and-emited (expr-memptr-deref 'p 'mem) "p.*mem")
+
+(check-item-and-emited (expr-ptrmemptr-deref 'p 'mem) "p->*mem")
+
+(check-item-and-emited (expr-preincr 'a) "++a")
+
+(check-item-and-emited (expr-predecr 'a) "--a")
+
+(check-item-and-emited (expr-postincr 'a) "a++")
+
+(check-item-and-emited (expr-postdecr 'a) "a--")
+
+(check-item-and-emited (expr-lognot 'p) "!p")
+
+(check-item-and-emited (expr-bitnot 'q) "~q")
+
+(check-item-and-emited (expr-deref 'p) "(*(p))")
+
+(check-item-and-emited (expr-address 'a) "(&(a))")
+
+(check-item-and-emited (expr-deref (expr-address 'a)) "(*((&(a))))")
+
+(check-item-and-emited (expr-pos 'a) "(+(a))")
+
+(check-item-and-emited (expr-neg 'a) "(-(a))")
+
+(check-item-and-emited (expr-sizeof 'a) "sizeof(a)")
+
+(check-item-and-emited (expr-new 'a) "new a")
+
+(check-item-and-emited (expr-new[] 'a) "new[] a")
+
+(check-item-and-emited (expr-delete 'a) "delete a")
+
+(check-item-and-emited (expr-delete[] 'a) "delete[] a")
+
+(check-item-and-emited (cpp-stringify 'foo) "#foo")
+
+(check-item-and-emited (expr-field 'p 'a) "p.a")
+
+(check-item-and-emited (expr-field 'p 'a 'b 'c) "p.a.b.c")
+
+(check-item-and-emited (expr-ptrfield 'p 'a) "p->a")
+
+(check-item-and-emited (expr-ptrfield 'p 'q 'r 'a) "p->q->r->a")
+
+(check-item-and-emited (expr-aref 'a 1 2 3) "a[1][2][3]")
+
+(check-item-and-emited (expr-call 'f 1 2 3) "f(1,2,3)")
+
+(check-item-and-emited (expr-call 'f (expr-seq 1 2) 3) "f(1,2,3)")
+
+(check-item-and-emited (absolute-scope 'a) "::a")
+
+(check-item-and-emited (expr-scope 'b 'c) "b::c")
+
+(check-item-and-emited (expr-scope 'a) "a")
+
+(check-item-and-emited (cpp-join 'foo 'bar) "foo##bar")
+
+(check-item-and-emited (stmt-expr (assign 'a 1))
+                       "
+a=1;
+")
+
+(check-item-and-emited (ensure-statement (assign 'a 1))
+                       "a=1;
+")
+
+(check-item-and-emited (stmt-label 'foo (ensure-statement (assign 'a 1)))
+                       "foo:
+a=1;
+")
+
+(check-item-and-emited (stmt-case 'bar (ensure-statement (assign 'a 1)))
+                       "case bar:
+a=1;
+")
+
+(check-item-and-emited (stmt-default (ensure-statement (assign 'a 1)))
+                       "default:
+a=1;
+")
+
+(check-item-and-emited
+ (stmt-block (list (ensure-statement (assign 'a 1)) (ensure-statement (assign 'b 2)) (ensure-statement (assign 'c 3))))
+ "{
+    a=1;
+    b=2;
+    c=3;
+}")
+
+(check-item-and-emited
+ (stmt-let (list (ensure-statement (assign 'a 'x)) (ensure-statement (assign 'b 'y)) (ensure-statement (assign 'c 'z)))
+           (list))
+ "
+{
+a=x;
+b=y;
+c=z;
+}")
+
+(check-item-and-emited (stmt-if (expr-call 'print 'a) (expr-call 'print 'b) (expr-eq 'a 'b))
+                       "
+if(a==b)
+    CommonLisp_print(a);
+else
+    CommonLisp_print(b);
+")
+
+(check-item-and-emited (stmt-if (expr-call 'print 'a) nil (expr-eq 'a 'b))
+                       "if(a==b)
+    CommonLisp_print(a);
+")
+
+(check-item-and-emited
+ (stmt-switch (stmt-block (list (stmt-case 'foo (ensure-statement (assign 'a 1)))
+                                (stmt-break)
+                                (stmt-case 'bar (ensure-statement (assign 'a 2)))
+                                (stmt-break)
+                                (stmt-default (ensure-statement (assign 'a 3)))))
+              (expr-seq 'x))
+ "switch(x){
+    case foo:
+    a=1;
+    break;
+    case bar:
+    a=2;
+    break;
+    default:
+    a=3;
+}")
+
+(check-item-and-emited (stmt-while (ensure-statement (assign-plus 'a 'b)) (expr-eq 'a 'b))
+                       "
+while(a==b)
+    a+=b;
+")
+
+(check-item-and-emited (stmt-do (stmt-block (list (assign-plus 'a 'b))) (expr-eq 'a 'b))
+                       "do{
+    a+=b;
+}while(a==b)")
+
+(check-item-and-emited
+ (stmt-for (assign 'a '0) (expr-lt 'a '100) (expr-postincr 'a) (stmt-block (list (assign-plus 'a 'b))))
+ "
+for(a=0;a<100;a++){
+    a+=b;
+}")
+
+(check-item-and-emited (stmt-break)
+"
+break;
+")
+
+(check-item-and-emited (stmt-continue)
+"continue;
+")
+
+(check-item-and-emited (stmt-return nil)
+"return;
+")
+
+(check-item-and-emited (stmt-return 42)
+"return 42;
+")
+
+(check-item-and-emited (stmt-goto 'foo)
+"goto foo;
+")
+
+(check-item-and-emited (asm "move.l d0,d1")
+                       "asm(\"move.l d0,d1\");
+")
+
+(check-item-and-emited (extern1 "C" (asm "move.l d0,d1"))
+                       "extern \"C\"
+asm(\"move.l d0,d1\");
+")
+
+(check-item-and-emited (extern "C" (list (asm "move.l d0,d1") (asm "move.l d2,d0")))
+                       "extern \"C\"{
+    asm(\"move.l d0,d1\");
+    asm(\"move.l d2,d0\");
+}
+")
+
+(check-item-and-emited (with-extern "C" (asm "move.l d0,d1") (asm "move.l d2,d0"))
+                       "extern \"C\"{
+    asm(\"move.l d0,d1\");
+    asm(\"move.l d2,d0\");
+}
+")
+
+(check-item-and-emited (pointer 'foo :const t :volatile t)
+                       "* const volatile foo")
+
+(check-item-and-emited (reference 'foo)
+                       "&foo")
+
+(check-item-and-emited (member-pointer 'bar 'foo :const t :volatile t)
+                       "bar* const volatile foo")
+
+(check-item-and-emited (c-function 'foo (list 'int) :const t :volatile t :throw '(error warning))
+                       "foo(int) const volatile throw (CommonLisp_error,CommonLisp_warning)")
+
+(check-item-and-emited (c-vector 'com.informatimago.languages.linc.c::|char| 42)
+                       "char[42]")
+
+
+;;;; THE END ;;;;
diff --git a/languages/linc/c-syntax.lisp b/languages/linc/c-syntax.lisp
index 574674d..dd240f9 100644
--- a/languages/linc/c-syntax.lisp
+++ b/languages/linc/c-syntax.lisp
@@ -49,13 +49,14 @@
 ;;;


-(defparameter *c-out* (make-synonym-stream '*standard-output*) "A stream.")
-(defvar *same-line* nil)
-(defvar *level* 99)
-(defvar *indent* 0)
-(defvar *naked* t)
+(defparameter *c-out*  (make-synonym-stream '*standard-output*) "A stream.")
+(defvar *same-line*    nil)
+(defvar *indent*       0)
+(defvar *naked*        t)
+(defvar *priority*    999)
+(defvar *opt-space*   " ")
+(defvar *bol*          t)

-(defvar *bol* t)
 (defun emit (&rest args)
   (loop
     :for arg :in args
@@ -79,7 +80,17 @@
      ,@body))

 (defmacro with-parens (parens &body body)
-  `(let ((*level* 99))
+  `(let ((*priority* 999))
+     (emit ,(elt parens 0))
+     (unwind-protect (with-indent ,@body)
+       (emit ,(elt parens 1)))))
+
+(defmacro without-parens (&body body)
+  `(let ((*priority* -1))
+     ,@body))
+
+(defmacro with-parens-without (parens &body body)
+  `(let ((*priority* -1))
      (emit ,(elt parens 0))
      (unwind-protect (with-indent ,@body)
        (emit ,(elt parens 1)))))
@@ -127,6 +138,8 @@ Rules:    - With no alphanumeric, we don't touch it (assumed name of a C operato
     (intern (snail-case (format nil "~{~A~}" items))
             *c-package-name*)))

+(deftype c-identifier () 'symbol)
+
 ;;; --------------------------------------------------------------------
 ;;;

@@ -197,19 +210,19 @@ Rules:    - With no alphanumeric, we don't touch it (assumed name of a C operato

 ;;;---------------------------------------------------------------------
 (defclass include (c-item)
-  ((type :initarg :type :reader include-type :type (member :system :local))
-   (file :initarg :file :reader include-file)))
+  ((type  :initarg :type :reader include-type :type (member :system :local))
+   (files :initarg :file :reader include-file)))

 (defun include (type file)
   (make-instance 'include :type type :file file))

 (defmethod generate ((item include))
-  (let ((*indent* 0)))
-  (emit :fresh-line "#include" " ")
-  (ecase (include-type item)
-    (:system (with-parens ("<" ">")   (emit (include-file item))))
-    (:local  (with-parens ("\"" "\"") (emit (include-file item)))))
-  (emit :newline))
+  (let ((*indent* 0))
+    (emit :fresh-line "#include" " ")
+    (ecase (include-type item)
+      (:system (with-parens "<>"   (emit (include-file item))))
+      (:local  (with-parens "\"\"" (emit (include-file item)))))
+    (emit :newline)))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -281,27 +294,8 @@ Defines a macro and a predicate for each KIND:
   "
 BUG: What about the character encoding of C strings?
 "
-  ;; TODO: Get the C-string writer to generate this.
   (emit (with-output-to-string (out)
-          (princ "\"" out)
-          (loop
-             :for ch :across self
-             :do (princ (case ch
-                          #+#.(cl:if (cl:char/= #\newline #\return) '(:and) '(:or))
-                          ((#\newline)            "\\n")
-                          #+#.(cl:if (cl:char/= #\newline #\linefeed) '(:and) '(:or))
-                          ((#\linefeed)           "\\l")
-                          ((#\return)             "\\r")
-                          ((#\tab)                "\\t")
-                          ((#\bell)               "\\a")
-                          ((#\page)               "\\f")
-                          ((#\vt)                 "\\v")
-                          ((#\")                  "\\\"")
-                          (otherwise
-                           (if (< (char-code ch) 32)
-                             (format nil "\\~3,'0o" (char-code ch))
-                             ch))) out))
-          (princ "\"" out))))
+          (write-c-string self out))))

 (defmethod generate ((self character))
   (let ((code (char-code self)))
@@ -363,9 +357,12 @@ BUG: What about the character encoding of C strings?
 ;;; EXPRESSIONS
 ;;;

+;; --------------------
 (defclass c-expression (c-item)
   ())

+(defmethod priority ((item c-expression)) 999)
+
 (defgeneric c-name (c-expression)
   (:method ((self c-expression))
     (error "I don't know the C operation name for an c-expression of class ~A"
@@ -378,22 +375,61 @@ BUG: What about the character encoding of C strings?

 (defmethod print-object ((self c-expression) stream)
   (if *print-readably*
+    (prin1 `(,(class-name (class-of self))
+              ,@(mapcar (lambda (arg) (if (cl:typep arg 'c-item) arg `(quote ,arg)))
+                        (arguments self)))
+           stream)
     (print-unreadable-object (self stream :identity t :type t)
       (with-slots (c-name priority associativity) self
         (let ((arguments (arguments self)))
           (format stream ":c-name ~S :priority ~A :associativity ~A ~
-                               :arguments ~S"
-                  c-name priority associativity arguments))))
-    (prin1 `(,(class-name (class-of self))
-              ,@(mapcar (lambda (arg) (if (cl:typep arg 'c-item) arg `(quote ,arg)))
-                        (arguments self))) stream))
+                               :arguments ~A"
+                  c-name priority associativity arguments)))))
   self)

 (defmethod c-sexp ((self c-expression))
   `(,(c-identifier (c-name self)) ,@(mapcar (function c-sexp) (arguments self))))

+;; --------------------
+(defclass c-varref (c-expression)
+  ((variable :initarg :variable :reader c-varref-variable :type symbol)))
+
+(defun c-varref (variable)
+  (make-instance 'c-varref :variable variable))
+
+(defmethod generate ((item c-varref))
+  (generate (c-varref-variable item)))
+
+(defmethod print-object ((self c-varref) stream)
+  (if *print-readably*
+      (prin1 (c-varref-variable item) stream)
+      (print-unreadable-object (self stream :identity t :type t)
+        (with-slots (variable) self
+          (format stream ":variable ~S" variable))))
+  self)
+
+;; --------------------
+(defclass c-literal (c-expression)
+  ;; TODO: structure etc. literals?  (point){1,2}
+  ((value :initarg :value :reader c-literal-value :type (or string character integer float))))
+
+(defmethod generate ((item c-literal))
+  (generate (c-literal-value item)))
+
+(defun c-literal (value)
+  (make-instance 'c-literal :value value))

+(defmethod print-object ((self c-literal) stream)
+  (if *print-readably*
+      (prin1 (c-literal-value item) stream)
+      (print-unreadable-object (self stream :identity t :type t)
+        (with-slots (value) self
+          (format stream ":value ~S" value))))
+  self)

+
+
+;; --------------------
 (defclass 0-*-arguments ()
   ((arguments :initarg :arguments
               :writer (setf arguments)
@@ -541,35 +577,84 @@ exclusive, but one must be given when :arguments is not given.")



-;; (type-pointer  1 ,(lambda (level type)
-;;                    ;; (cast var (pointer char)) --> (char*)var;
-;;                    (generate type :level level :naked nil)
-;;                    (emit "*")))
+(defclass c-operator ()
+  ((text         :initarg :text         :reader c-operator-text)
+   (prefix-space :initarg :prefix-space :reader c-operator-prefix-space :initform t)
+   (suffix-space :initarg :suffix-space :reader c-operator-suffix-space :initform t)))

+(defgeneric c-operator-optional-prefix-space (operator optional-space)
+  (:method ((operator symbol) optional-space)
+    optional-space)
+  (:method ((operator c-operator) optional-space)
+    (if (plusp (length optional-space))
+        (if (c-operator-prefix-space operator) optional-space "")
+        optional-space)))

-;; (com.informatimago.languages.linc.c::literal    1 ,(lambda (level token)
-;;                      (declare (ignore level))
-;;                      (emit (if (stringp token)
-;;                              (lisp->c-string token)
-;;                              token))))
-;; (com.informatimago.languages.linc.c::identifier 1 ,(lambda (level token)
-;;                      (declare (ignore level))
-;;                      (generate token)))
+(defgeneric c-operator-optional-suffix-space (operator optional-space)
+  (:method ((operator symbol) optional-space)
+    optional-space)
+  (:method ((operator c-operator) optional-space)
+    (if (plusp (length optional-space))
+        (if (c-operator-suffix-space operator) optional-space "")
+        optional-space)))
+
+(defgeneric c-operator-p (object)
+  (:method ((symbol symbol))
+    (and (fboundp symbol)
+         (get symbol 'operator)
+         symbol))
+  (:method ((operator c-operator))
+    (c-operator-text c-operator)))
+
+
+(defun generate-list (separator generator list)
+  (when list
+    (flet ((gen (item)
+             (etypecase separator
+               (string
+                (emit *opt-space* separator *opt-space*))
+               ((or symbol c-operator)
+                (emit (c-operator-optional-prefix-space separator *opt-space*)
+                      (c-operator-text separator)
+                      (c-operator-optional-suffix-space separator *opt-space*))))
+             (funcall generator item)))
+      (funcall generator (car list))
+      (map nil (function gen) (cdr list)))))


 (defun gen-operator (cl-name priority associativity arity
-                     c-name-or-generator)
-  (let ((c-name (if (stringp c-name-or-generator)
-                    c-name-or-generator
-                    (string cl-name))))
+                     operator generator)
+  (assert (or operator generator))
+  (let* ((c-name     (cond
+                       ((null operator)                            (string cl-name))
+                       ((listp operator)                           (first  operator))
+                       ((or (stringp operator) (symbolp operator)) (string operator))
+                       (t            (error "Invalid operator argument ~S" operator))))
+         (c-prefix   (cond
+                       ((null operator)                            t)
+                       ((listp operator)                           (second operator))
+                       ((or (stringp operator) (symbolp operator)) t)
+                       (t            (error "Invalid operator argument ~S" operator))))
+         (c-suffix   (cond
+                       ((null operator)                            t)
+                       ((listp operator)                           (third operator))
+                       ((or (stringp operator) (symbolp operator)) t)
+                       (t            (error "Invalid operator argument ~S" operator))))
+         (c-sym      (c-identifier (string-downcase c-name)))
+         (c-operator (if operator
+                         `(make-instance 'c-operator
+                                         :text ',c-name
+                                         :prefix-space ',c-prefix
+                                         :suffix-space ',c-suffix)
+                         `',c-sym)))
     (list `(defclass ,cl-name (,(ecase arity
-                                       ((0-*) '0-*-arguments)
-                                       ((1-*) '1-*-arguments)
-                                       ((2-*) '2-*-arguments)
-                                       ((1)   '1-argument)
-                                       ((2)   '2-arguments)
-                                       ((3)   '3-arguments))
-                                c-expression)
+                                  ((0-*) '0-*-arguments)
+                                  ((1-*) '1-*-arguments)
+                                  ((2-*) '2-*-arguments)
+                                  ((1)   '1-argument)
+                                  ((2)   '2-arguments)
+                                  ((3)   '3-arguments))
+                               c-expression)
              ((priority      :initform ,priority
                              :reader priority
                              :allocation :class)
@@ -580,180 +665,208 @@ exclusive, but one must be given when :arguments is not given.")
                              :reader c-name
                              :allocation :class)))
           `(defun ,cl-name ,(ecase arity
-                                   ((0-*) '(&rest arguments))
-                                   ((1-*) '(one &rest arguments))
-                                   ((2-*) '(one two &rest arguments))
-                                   ((1)   '(one))
-                                   ((2)   '(one two))
-                                   ((3)   '(one two three)))
+                              ((0-*) '(&rest arguments))
+                              ((1-*) '(one &rest arguments))
+                              ((2-*) '(one two &rest arguments))
+                              ((1)   '(one))
+                              ((2)   '(one two))
+                              ((3)   '(one two three)))
              (make-instance ',cl-name
-                 :arguments ,(ecase arity
-                                    ((0-*) 'arguments)
-                                    ((1-*) '(cons one arguments))
-                                    ((2-*) '(list* one two arguments))
-                                    ((1)   '(list one))
-                                    ((2)   '(list one two))
-                                    ((3)   '(list one two three)))))
-          `(setf (symbol-function ',(c-identifier (string-downcase c-name)))
-                 (symbol-function ',cl-name))
+                            :arguments ,(ecase arity
+                                          ((0-*) 'arguments)
+                                          ((1-*) '(cons one arguments))
+                                          ((2-*) '(list* one two arguments))
+                                          ((1)   '(list one))
+                                          ((2)   '(list one two))
+                                          ((3)   '(list one two three)))))
           `(defmethod generate ((self ,cl-name))
-             ,(if (stringp c-name-or-generator)
-                  (if (eql 1 arity)
-                      `(progn
-                         (emit ,c-name-or-generator)
-                         (generate (argument self)))
-                      `(generate-list ,c-name-or-generator
-                                      (function generate)
-                                      (arguments self)))
-                  `(apply ,c-name-or-generator (arguments self)))
-             (values)))))
+             ,(cond
+                (generator      `(apply ,generator (arguments self)))
+                ((eql 1 arity)  `(progn
+                                   (emit ,c-name)
+                                   (generate (argument self))))
+                (t              `(generate-list ,c-operator
+                                                (function generate)
+                                                (arguments self))))
+             (values))
+          (when c-sym
+            `(setf (symbol-function ',c-sym)
+                   (symbol-function ',cl-name)))
+          (when c-sym
+            `(setf (get ',c-sym 'operator) ',c-sym))
+          `',cl-name)))
+
+;; (let ((*print-right-margin* 72))
+;;   (pprint (gen-operator 'expr-address  42 :unary  1  NIL '(LAMBDA (ARGUMENT) (WITH-PARENS "()" (EMIT "&") (WITH-PARENS "()" (GENERATE ARGUMENT)))))))
+;;
+;; (pprint (destructuring-bind  (cl-name priority associativity arity
+;;                         c-name generator)
+;;       '(expr-address  42 :unary  1  NIL (LAMBDA (ARGUMENT) (WITH-PARENS "()" (EMIT "&") (WITH-PARENS "()" (GENERATE ARGUMENT)))))
+;;     (let* ((c-sym  (when (stringp c-name)
+;;                      (c-identifier (string-downcase c-name))))
+;;            (c-name (if (stringp c-name)
+;;                        c-name
+;;                        (string cl-name))))
+;;       (print c-sym)
+;;       (print c-name)
+;;       `(defmethod generate ((self ,cl-name))
+;;          ,(if (stringp c-name)
+;;               (if (eql 1 arity)
+;;                   `(progn
+;;                      (emit ,c-name)
+;;                      (generate (argument self)))
+;;                   `(generate-list ,c-name
+;;                                   (function generate)
+;;                                   (arguments self)))
+;;               `(apply ,generator (arguments self)))
+;;          (values)))))


 (defmethod generate :around ((self c-expression))
-  (if (and *naked* (not *level*))
-      (let ((*level* -1)
-            (*naked* nil))
+  (if (< (priority self) *priority*)
+      ;; need parentheses:
+      (with-parens "()"
         (call-next-method))
-      (let ((*level* (priority self))
-            (*naked* nil))
-        (if (< (priority self) *level*)
-            ;; need parentheses:
-            (with-parens "()" (call-next-method))
-            ;; no need for parentheses:
-            (call-next-method))))
+      ;; no need for parentheses:
+      (let ((*priority* (priority self)))
+        (call-next-method)))
+
+  ;; (if (and *naked* (not *priority*))
+  ;;     (let ((*priority* -1)
+  ;;           (*naked* nil))
+  ;;       (call-next-method))
+  ;;     )
   (values))


-(defun generate-list (separator generator list)
-  (when list
-    (flet ((gen (item) (emit separator) (funcall generator item)))
-      (funcall generator (car list))
-      (map nil (function gen) (cdr list)))))


+(defparameter *operators*
+  '(
+    (:left
+     (expr-seq             1-* ("," nil t)))
+    (:left
+     (expr-callargs        0-* nil     (lambda (&rest arguments)
+                                         (generate-list (make-instance 'c-operator :text "," :prefix-space nil :suffix-space t)
+                                                        (function generate)
+                                                        arguments))))
+    ;; expr-callargs has higher priority than expr-seq to force parens in: fun(arg,(f(a),g(b)),arg);
+    (:right
+     (assign               2-* "=")
+     (assign-times         2-* "*=")
+     (assign-divided       2-* "/=")
+     (assign-modulo        2-* "%=")
+     (assign-plus          2-* "+=")
+     (assign-minus         2-* "-=")
+     (assign-right-shift   2-* ">>=")
+     (assign-left-shift    2-* "<<=")
+     (assign-bitand        2-* "&=")
+     (assign-bitor         2-* "|=")
+     (assign-bitxor        2-* "^="))
+
+    (:right
+     (expr-if              3   "?"       (lambda (condi then else)
+                                           (let ((*priority* (1+ *priority*)))
+                                             (generate condi)
+                                             (emit "?")
+                                             (generate then))
+                                           (emit ":")
+                                           (generate else))))
+
+    (:left
+     (expr-logor           2-* "||"))
+    (:left
+     (expr-logand          2-* "&&"))
+    (:left
+     (expr-bitor           2-* "|"))
+    (:left
+     (expr-bitxor          2-* "^"))
+    (:left
+     (expr-bitand          2-* "&"))
+    (:left
+     (expr-eq              2   "==")
+     (expr-ne              2   "!="))
+    (:left
+     (expr-lt              2   "<")
+     (expr-gt              2   ">")
+     (expr-le              2   "<=")
+     (expr-ge              2   ">="))
+    (:left
+     (expr-left-shift      2   "<<")
+     (expr-right-shift     2   ">>"))
+    (:left
+     (expr-plus            2-* "+")
+     (expr-minus           2-* "-"))
+    (:left
+     (expr-times           2-* "*")
+     (expr-divided         2-* "/")
+     (expr-modulo          2-* "%"))
+    (:left
+     (expr-memptr-deref    2   (".*" nil nil))
+     (expr-ptrmemptr-deref 2   ("->*" nil nil)))
+    (:right
+     (expr-cast            2   "cast"
+      (lambda (expression type)
+        (with-parens "()" (generate type))
+        (let ((*naked* nil)) (generate expression)))))
+    (:unary
+     (expr-preincr         1   "++")
+     (expr-predecr         1   "--"))
+
+    (:unary
+     (expr-lognot          1   "!")
+     (expr-bitnot          1   "~")
+     (expr-deref           1   nil        (lambda (argument) (emit "*") (generate argument)))
+     (expr-address         1   nil        (lambda (argument) (emit "&") (generate argument)))
+     (expr-pos             1   nil        (lambda (argument) (emit "+") (generate argument)))
+     (expr-neg             1   nil        (lambda (argument) (emit "-") (generate argument))))
+    (:unary
+     (expr-sizeof          1   "sizeof"   (lambda (argument) (emit "sizeof")   (with-parens "()" (generate argument))))
+     (expr-alignof         1   "alignof"  (lambda (argument) (emit "_Alignof") (with-parens "()" (generate argument))))
+     (expr-new             1   "new"      (lambda (argument) (emit "new" " ") (generate argument)))
+     (expr-new[]           1   "new[]"    (lambda (argument) (emit "new" "[]" " ") (generate argument)))
+     (expr-delete          1   "delete"   (lambda (argument) (emit "delete" " ") (generate argument)))
+     (expr-delete[]        1   "delete[]" (lambda (argument) (emit "delete" "[]" " ") (generate argument)))
+     (cpp-stringify        1   "#"))
+    (:post
+     (expr-postincr        1   nil        (lambda (expr) (generate expr) (emit "++")))
+     (expr-postdecr        1   nil        (lambda (expr) (generate expr) (emit "--")))
+     (expr-field           2-* ("."  nil nil))
+     (expr-ptrfield        2-* ("->" nil nil))
+     (expr-aref            2-* "aref"    (lambda (&rest expressions)
+                                           (generate (first expressions))
+                                           (dolist (expr (rest expressions))
+                                             (with-parens "[]" (generate expr)))))
+     (expr-call           1-* nil        (lambda (operator &rest arguments)
+                                           (generate operator)
+                                           (with-parens "()"
+                                             (let ((*priority* (position 'expr-callargs *operators*
+                                                                         :key (function rest)
+                                                                         :test (lambda (op defs) (member op defs :key (function first))))))
+                                               (if (and (= 1 (length arguments))
+                                                        (cl:typep (first arguments) 'expr-callargs))
+                                                   (generate (first arguments))
+                                                   (when arguments
+                                                     (generate (make-instance 'expr-callargs :arguments arguments)))))))))
+    (:left
+     (absolute-scope    1   nil
+      (lambda (name) (emit "::") (generate name))))
+    (:left
+     (expr-scope        1-* nil
+      (lambda (&rest names)
+        (generate-list "::" (function generate) names))))
+    (:left
+     (cpp-join          2   "##"))))
+
 (defun make-operators ()
   (loop
     :for priority :from 0
-    :for (associativity . operators) :in
-    '((:left
-       (expr-seq             1-* ","))
-      (:left
-       (expr-callargs        0-* ","))
-      ;; expr-args above expr-seq to force parens in: fun(arg,(f(a),g(b)),arg);
-      (:right
-       (expr-if              3
-        (lambda (condi then else)
-          (let ((*level* (1+ *level*))
-                (*naked* nil))
-            (generate condi)
-            (emit "?")
-            (generate then))
-          (emit ":")
-          (generate else)))
-       (assign               2-* "=")
-       (assign-times         2-* "*=")
-       (assign-divided       2-* "/=")
-       (assign-modulo        2-* "%=")
-       (assign-plus          2-* "+=")
-       (assign-minus         2-* "-=")
-       (assign-right-shift   2-* ">>=")
-       (assign-left-shift    2-* "<<=")
-       (assign-bitand        2-* "&=")
-       (assign-bitor         2-* "|=")
-       (assign-bitxor        2-* "^="))
-      (:left
-       (expr-logor           2-* "||"))
-      (:left
-       (expr-logand          2-* "&&"))
-      (:left
-       (expr-bitor           2-* "|"))
-      (:left
-       (expr-bitxor          2-* "^"))
-      (:left
-       (expr-bitand          2-* "&"))
-      (:left
-       (expr-eq              2   "==")
-       (expr-ne              2   "!="))
-      (:left
-       (expr-lt              2   "<")
-       (expr-gt              2   ">")
-       (expr-le              2   "<=")
-       (expr-ge              2   ">="))
-      (:left
-       (expr-left-shift      2   "<<")
-       (expr-right-shift     2   ">>"))
-      (:left
-       (expr-plus            2-* "+")
-       (expr-minus           2-* "-"))
-      (:left
-       (expr-times           2-* "*")
-       (expr-divided         2-* "/")
-       (expr-modulo          2-* "%"))
-      (:left
-       (expr-memptr-deref    2   ".*")
-       (expr-ptrmemptr-deref 2   "->*"))
-      (:right
-       (expr-cast 2
-        (lambda (expression type)
-          (with-parens "()" (generate type))
-          (let ((*naked* nil)) (generate expression)))))
-      (:unary
-       (expr-preincr         1   "++")
-       (expr-predecr         1   "--")
-       (expr-lognot          1   "!")
-       (expr-bitnot          1   "~")
-       (expr-deref           1   (lambda (argument) (with-parens "()" (emit "*") (with-parens "()" (generate argument)))))
-       (expr-address         1   (lambda (argument) (with-parens "()" (emit "&") (with-parens "()" (generate argument)))))
-       (expr-pos             1   (lambda (argument) (with-parens "()" (emit "+") (with-parens "()" (generate argument)))))
-       (expr-neg             1   (lambda (argument) (with-parens "()" (emit "-") (with-parens "()" (generate argument)))))
-       (expr-sizeof          1   (lambda (argument) (emit "sizeof") (with-parens "()" (generate argument))))
-       (expr-new             1   (lambda (argument) (emit "new" " ") (generate argument)))
-       (expr-new[]           1   (lambda (argument) (emit "new" "[]" " ") (generate argument)))
-       (expr-delete          1   (lambda (argument) (emit "delete" " ") (generate argument)))
-       (expr-delete[]        1   (lambda (argument) (emit "delete" "[]" " ") (generate argument)))
-       (cpp-stringify        1   "#"))
-      (:post
-       (expr-postincr         1
-        (lambda (expr)
-          (let ((*naked* nil)) (generate expr)) (emit "++")))
-       (expr-postdecr         1
-        (lambda (expr)
-          (let ((*naked* nil)) (generate expr)) (emit "--")))
-       (expr-field    2-* ".")
-       (expr-ptrfield 2-* "->")
-       (expr-aref     2-*
-        (lambda (&rest expressions)
-          (let ((*naked* nil))
-            (generate (first expressions))
-            (dolist (expr (rest expressions))
-              (with-parens "[]" (generate expr))))))
-       (expr-call     1-*
-        (lambda (&rest expressions)
-          (let ((*naked* nil))
-            (generate (first expressions))
-            (if (and (= 2 (length expressions))
-                     (cl:typep (second expressions) 'expr-callargs))
-                (with-parens "()"
-                  (generate (second expressions)))
-                (with-parens "()"
-                  (when (rest expressions)
-                    (generate
-                     (make-instance 'expr-callargs
-                                    :arguments (rest expressions))))))))))
-      (:left
-       (absolute-scope    1
-        (lambda (name) (emit "::") (generate name))))
-      (:left
-       (expr-scope        1-*
-        (lambda (&rest names)
-          (generate-list "::" (function generate) names))))
-      (:left
-       (cpp-join          2   "##")))
+    :for (associativity . operators) :in *operators*
     :nconc (loop
              :for op :in operators
-             :nconc (destructuring-bind (cl-name arity c-name-or-generator) op
+             :nconc (destructuring-bind (cl-name arity c-name &optional generator) op
                       (gen-operator cl-name priority associativity arity
-                                    c-name-or-generator)))))
+                                    c-name generator)))))

 (defmacro gen-operators ()
   `(progn ,@(make-operators)))
@@ -765,14 +878,26 @@ exclusive, but one must be given when :arguments is not given.")
 ;;;


-(defclass statement (c-item)
+(defclass c-statement (c-item)
   ())

+
+(defclass c-sequence (c-item)
+  ((elements :initarg :elements :reader c-sequence-elements)))
+
+(defun c-sequence (&rest items)
+  (make-instance 'c-sequence :elements items))
+
+(defmethod generate ((item c-sequence))
+  (dolist (element (c-sequence-elements item))
+    (generate element)))
+
+
 (defclass optional-statement ()
-  ((statement :initarg :sub-statement
+  ((c-statement :initarg :sub-statement
               :accessor sub-statement
               :initform nil
-              :type (or null statement))))
+              :type (or null c-statement))))

 (defmethod arguments append ((self optional-statement))
   (when (sub-statement self) (list (sub-statement self))))
@@ -815,7 +940,7 @@ exclusive, but one must be given when :arguments is not given.")
                                     &key print-object c-sexp generate)
   `(progn

-     (defclass ,cl-name (,@optional-superclasses statement)
+     (defclass ,cl-name (,@optional-superclasses c-statement)
        (,@(mapcar (lambda (field)
                       `(,field :initarg ,(keywordize field) :accessor ,field))
                   fields)
@@ -859,14 +984,15 @@ exclusive, but one must be given when :arguments is not given.")

 (define-statement stmt-expr () (stmt-expression) "expression"
   :generate (progn
-              (emit :fresh-line)
-              (generate (stmt-expression self))
+              (unless *same-line* (emit :fresh-line))
+              (without-parens
+                (generate (stmt-expression self)))
               (emit ";" :newline)))


 (defgeneric ensure-statement (item)
-  (:method ((self t))         (stmt-expr self))
-  (:method ((self statement))   self))
+  (:method ((self t))             (stmt-expr self))
+  (:method ((self c-statement))   self))


 (define-statement stmt-label (optional-statement) (identifier) "label"
@@ -880,7 +1006,8 @@ exclusive, but one must be given when :arguments is not given.")
   :generate (progn
               (unless *same-line* (emit :fresh-line))
               (generate (identifier self)) (emit ":")
-              (generate (ensure-statement (sub-statement self)))))
+              (when (sub-statement self)
+                (generate (ensure-statement (sub-statement self))))))


 (define-statement stmt-case (optional-statement) (case-value) "case"
@@ -970,9 +1097,9 @@ exclusive, but one must be given when :arguments is not given.")
   ;;                                       ; generate
   :generate (progn
               (unless *same-line* (emit :fresh-line))
-              (emit "if" "(")
-              (generate (condition-expression self))
-              (emit ")")
+              (emit "if")
+              (with-parens-without ("(" ")")
+                (generate (condition-expression self)))
               (generate-with-indent (then self))
               (when (else self)
                 (emit "else")
@@ -991,9 +1118,9 @@ exclusive, but one must be given when :arguments is not given.")
   ;;                                       ; generate
   :generate (progn
               (unless *same-line* (emit :fresh-line))
-              (emit "switch" "(")
-              (generate (condition-expression self))
-              (emit ")")
+              (emit "switch")
+              (with-parens-without ("(" ")")
+                (generate (condition-expression self)))
               (generate-with-indent (sub-statement self))))


@@ -1009,9 +1136,9 @@ exclusive, but one must be given when :arguments is not given.")
   ;;                                       ; generate
   :generate (progn
               (unless *same-line* (emit :fresh-line))
-              (emit "while" "(")
-              (generate (condition-expression self))
-              (emit ")")
+              (emit "while")
+              (with-parens-without ("(" ")")
+                (generate (condition-expression self)))
               (generate-with-indent (sub-statement self))))


@@ -1031,12 +1158,13 @@ exclusive, but one must be given when :arguments is not given.")
               (if (sub-statement self)
                 (generate-with-indent (sub-statement self))
                 (emit ";"))
-              (emit "while" "(")
-              (generate (condition-expression self))
-              (emit ")")))
+              (emit "while")
+              (with-parens-without ("(" ")")
+                (generate (condition-expression self)))
+              (emit ";")))

 (define-statement stmt-for (optional-statement)
-    (for-init-statement go-on-condition step-expression) "for"
+  (for-init-statement go-on-condition step-expression) "for"
   ;;                                       ; print-object
   ;; `(,(class-name (class-of self))
   ;;    ,(for-init-statement  self)
@@ -1052,16 +1180,20 @@ exclusive, but one must be given when :arguments is not given.")
   ;;                                       ; generate
   :generate (progn
               (unless *same-line* (emit :fresh-line))
-              (emit "for" "(")
-              (generate (for-init-statement  self))
-              (emit ";")
-              (generate (go-on-condition     self))
-              (emit ";")
-              (generate (step-expression     self))
-              (emit ")")
+              (let ((*same-line* t))
+                (emit "for" "(")
+                (without-parens
+                  (generate (for-init-statement  self)))
+                (emit ";")
+                (without-parens
+                  (generate (go-on-condition     self)))
+                (emit ";")
+                (without-parens
+                  (generate (step-expression     self)))
+                (emit ")"))
               (if (sub-statement self)
-                (generate-with-indent (sub-statement self))
-                (emit ";"))))
+                  (generate-with-indent (sub-statement self))
+                  (emit ";"))))


 (define-statement stmt-break () () "break"
@@ -1262,86 +1394,86 @@ exclusive, but one must be given when :arguments is not given.")
 ;;                reference

 ;; TODO: We need to manage some level with declarators. Check if we
-;;       can use the same *level* as the expressions.
-
-(defclass declarator (c-item)
-  ())
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defgeneric parameters (lambda-list))
-  (defmethod parameters ((self ordinary-lambda-list))
-    (append (lambda-list-mandatory-parameters self)
-            (lambda-list-optional-parameters self)
-            (when (lambda-list-rest-parameter-p self)
-              (list (lambda-list-rest-parameter self)))
-            (lambda-list-keyword-parameters self)))
-  (defun arg-form (arg)
-    `(if (cl:typep ,arg 'c-item)
-         ,arg
-         (list 'quote ,arg)))
-  (defun generate-print-object (name ll fields)
-    `(defmethod print-object ((self ,name) stream)
-       (with-slots (,@fields) self
-         (print (list* ',name
-                       ,@(mapcar (lambda (parameter)
-                                   (arg-form (parameter-name parameter)))
-                                 (lambda-list-mandatory-parameters ll))
-                       ,@(mapcar (lambda (parameter)
-                                   (let ((arg (parameter-name parameter)))
-                                     `(when (slot-boundp self ',arg)
-                                        ,(arg-form arg))))
-                                 (lambda-list-optional-parameters ll))
-                       (append
-                        ,@(mapcar (lambda (parameter)
-                                    (let ((arg (parameter-name parameter)))
-                                      `(when (slot-boundp self ',arg)
-                                         (list
-                                          ,(keywordize arg)
-                                          ,(arg-form arg)))))
-                                  (lambda-list-keyword-parameters ll))))
-                stream))
-       self)))
-
-(defmacro define-declarator (name lambda-list &key generate)
-  (let* ((ll     (parse-lambda-list lambda-list))
-         (fields (mapcar (function parameter-name) (parameters ll))))
-    `(progn
-
-       (defclass ,name (declarator)
-         (,@(mapcar (lambda (field)
-                      `(,field
-                        :initarg ,(keywordize field)
-                        :accessor ,field))
-                    fields)))
-
-       (defmethod arguments append ((self ,name))
-         (with-slots ,fields self
-           (append
-            ,@(mapcar (lambda (field)
-                        `(when (slot-boundp self ',field)
-                           (list (slot-value self ',field))))
-                      fields))))
-
-       ,(generate-print-object name ll fields)
-
-       (defmethod c-sexp ((self ,name))
-         (cons
-          ',(c-identifier name)
-          (mapcar (function c-sexp) (arguments self))))
-
-       (defmethod generate ((self ,name))
-         (with-slots ,fields self
-           ,generate)
-         (values))
+;;       can use the same *priority* as the expressions.

-       #-(and) (defun ,name  ,lambda-list
-         (make-instance ',name ,@(make-argument-list ll)))
-
-       (defun ,name  ,lambda-list
-         (make-instance ',name
-                        ,@(loop :for field :in fields
-                                :nconc (list (keywordize field) field))))
-       ',name)))
+;; (defclass declarator (c-item)
+;;   ())
+;;
+;; (eval-when (:compile-toplevel :load-toplevel :execute)
+;;   (defgeneric parameters (lambda-list))
+;;   (defmethod parameters ((self ordinary-lambda-list))
+;;     (append (lambda-list-mandatory-parameters self)
+;;             (lambda-list-optional-parameters self)
+;;             (when (lambda-list-rest-parameter-p self)
+;;               (list (lambda-list-rest-parameter self)))
+;;             (lambda-list-keyword-parameters self)))
+;;   (defun arg-form (arg)
+;;     `(if (cl:typep ,arg 'c-item)
+;;          ,arg
+;;          (list 'quote ,arg)))
+;;   (defun generate-print-object (name ll fields)
+;;     `(defmethod print-object ((self ,name) stream)
+;;        (with-slots (,@fields) self
+;;          (print (list* ',name
+;;                        ,@(mapcar (lambda (parameter)
+;;                                    (arg-form (parameter-name parameter)))
+;;                                  (lambda-list-mandatory-parameters ll))
+;;                        ,@(mapcar (lambda (parameter)
+;;                                    (let ((arg (parameter-name parameter)))
+;;                                      `(when (slot-boundp self ',arg)
+;;                                         ,(arg-form arg))))
+;;                                  (lambda-list-optional-parameters ll))
+;;                        (append
+;;                         ,@(mapcar (lambda (parameter)
+;;                                     (let ((arg (parameter-name parameter)))
+;;                                       `(when (slot-boundp self ',arg)
+;;                                          (list
+;;                                           ,(keywordize arg)
+;;                                           ,(arg-form arg)))))
+;;                                   (lambda-list-keyword-parameters ll))))
+;;                 stream))
+;;        self)))
+
+;; (defmacro define-declarator (name lambda-list &key generate)
+;;   (let* ((ll     (parse-lambda-list lambda-list))
+;;          (fields (mapcar (function parameter-name) (parameters ll))))
+;;     `(progn
+;;
+;;        (defclass ,name (declarator)
+;;          (,@(mapcar (lambda (field)
+;;                       `(,field
+;;                         :initarg ,(keywordize field)
+;;                         :accessor ,field))
+;;                     fields)))
+;;
+;;        (defmethod arguments append ((self ,name))
+;;          (with-slots ,fields self
+;;            (append
+;;             ,@(mapcar (lambda (field)
+;;                         `(when (slot-boundp self ',field)
+;;                            (list (slot-value self ',field))))
+;;                       fields))))
+;;
+;;        ,(generate-print-object name ll fields)
+;;
+;;        (defmethod c-sexp ((self ,name))
+;;          (cons
+;;           ',(c-identifier name)
+;;           (mapcar (function c-sexp) (arguments self))))
+;;
+;;        (defmethod generate ((self ,name))
+;;          (with-slots ,fields self
+;;            ,generate)
+;;          (values))
+;;
+;;        #-(and) (defun ,name  ,lambda-list
+;;          (make-instance ',name ,@(make-argument-list ll)))
+;;
+;;        (defun ,name  ,lambda-list
+;;          (make-instance ',name
+;;                         ,@(loop :for field :in fields
+;;                                 :nconc (list (keywordize field) field))))
+;;        ',name)))

 ;; (declarator -->
 ;;             ((opt pointer) direct-declarator))
@@ -1351,32 +1483,32 @@ exclusive, but one must be given when :arguments is not given.")
 ;;          (* {const restrict volatile _Atomic} pointer))


-(define-declarator pointer (sub-declarator
-                            &key (const nil) (restrict nil) (volatile nil) (atomic nil))
-  :generate (progn (emit "*")
-                   (when const    (emit " " "const"))
-                   (when restrict (emit " " "restrict"))
-                   (when volatile (emit " " "volatile"))
-                   (when atomic   (emit " " "_Atomic"))
-                   (emit " ")
-                   (generate sub-declarator)))
+;; (define-declarator pointer (sub-declarator
+;;                             &key (const nil) (restrict nil) (volatile nil) (atomic nil))
+;;   :generate (progn (emit "*")
+;;                    (when const    (emit " " "const"))
+;;                    (when restrict (emit " " "restrict"))
+;;                    (when volatile (emit " " "volatile"))
+;;                    (when atomic   (emit " " "_Atomic"))
+;;                    (emit " ")
+;;                    (generate sub-declarator)))

 ;; C++
-(define-declarator reference (sub-declarator)
-  :generate (progn (emit "&") (generate sub-declarator)))
+;; (define-declarator reference (sub-declarator)
+;;   :generate (progn (emit "&") (generate sub-declarator)))

 ;; C++
-(define-declarator member-pointer (nested-name-specifier
-                                   sub-declarator
-                                   &key (const nil) (restrict nil) (volatile nil) (atomic nil))
-  :generate (progn (generate nested-name-specifier)
-                   (emit "*")
-                   (when const    (emit " " "const"))
-                   (when restrict (emit " " "restrict"))
-                   (when volatile (emit " " "volatile"))
-                   (when atomic   (emit " " "_Atomic"))
-                   (emit " ")
-                   (generate sub-declarator)))
+;; (define-declarator member-pointer (nested-name-specifier
+;;                                    sub-declarator
+;;                                    &key (const nil) (restrict nil) (volatile nil) (atomic nil))
+;;   :generate (progn (generate nested-name-specifier)
+;;                    (emit "*")
+;;                    (when const    (emit " " "const"))
+;;                    (when restrict (emit " " "restrict"))
+;;                    (when volatile (emit " " "volatile"))
+;;                    (when atomic   (emit " " "_Atomic"))
+;;                    (emit " ")
+;;                    (generate sub-declarator)))

 ;; (direct-declarator -->
 ;;                    identifier
@@ -1392,30 +1524,31 @@ exclusive, but one must be given when :arguments is not given.")



-(define-declarator c-vector (sub-declarator
-                             &optional dimension ; nil, *, or an assignment-expression.
-                             &key (const nil) (restrict nil) (volatile nil) (atomic nil) (static nil))
-  :generate (progn
-              (typecase sub-declarator
-                ;; or use some *level* and priority
-                ((or c-function c-vector        ; direct-declarator
-                     expr-scope absolute-scope) ; declarator-id
-                 (generate sub-declarator))
-                (declarator
-                 (with-parens "()"
-                   (generate sub-declarator)))
-                (c-item
-                 (error "A random C-ITEM ~S as C-VECTOR sub-declarator, really?"
-                        sub-declarator))
-                (t ;; raw declarator-id
-                 (generate sub-declarator)))
-              (with-parens "[]"
-                (let ((genspace nil))
-                  (when const     (when genspace (emit " ")) (emit "const")    (setf genspace t))
-                  (when restrict  (when genspace (emit " ")) (emit "restrict") (setf genspace t))
-                  (when volatile  (when genspace (emit " ")) (emit "volatile") (setf genspace t))
-                  (when atomic    (when genspace (emit " ")) (emit "_Atomic")  (setf genspace t))
-                  (when dimension (when genspace (emit " ")) (generate dimension))))))
+;; (define-declarator c-vector (sub-declarator
+;;                              &optional dimension ; nil, *, or an assignment-expression.
+;;                              &key (const nil) (restrict nil) (volatile nil) (atomic nil) (static nil))
+;;   :generate (progn
+;;               (typecase sub-declarator
+;;                 ;; or use some *priority* and priority
+;;                 ((or c-function c-vector        ; direct-declarator
+;;                      expr-scope absolute-scope) ; declarator-id
+;;                  (generate sub-declarator))
+;;                 (declarator
+;;                  (with-parens "()"
+;;                    (generate sub-declarator)))
+;;                 (c-item
+;;                  (error "A random C-ITEM ~S as C-VECTOR sub-declarator, really?"
+;;                         sub-declarator))
+;;                 (t ;; raw declarator-id
+;;                  (generate sub-declarator)))
+;;               (with-parens "[]"
+;;                 (let ((genspace nil))
+;;                   (when const     (when genspace (emit " ")) (emit "const")    (setf genspace t))
+;;                   (when restrict  (when genspace (emit " ")) (emit "restrict") (setf genspace t))
+;;                   (when volatile  (when genspace (emit " ")) (emit "volatile") (setf genspace t))
+;;                   (when atomic    (when genspace (emit " ")) (emit "_Atomic")  (setf genspace t))
+;;                   (when dimension (when genspace (emit " ")) (generate dimension))))))
+

 ;; (generate (c-vector 'arr (assign 'a 42) :const t :restrict t :volatile t :atomic t :static t))
 ;; arr[const restrict volatile _Atomic a=42]
@@ -1424,35 +1557,35 @@ exclusive, but one must be given when :arguments is not given.")
 ;; (generate (c-vector 'arr nil :const t))
 ;; arr[const]

-(define-declarator c-function (sub-declarator
-                               parameters
-                               &key (const nil) (volatile nil) ((:throw throw-list) nil))
-  :generate (progn
-              (typecase sub-declarator
-                ;; or use some *level* and priority
-                ((or c-function c-vector        ; direct-declarator
-                     expr-scope absolute-scope) ; declarator-id
-                 (generate sub-declarator))
-                (declarator
-                 (with-parens "()"
-                   (generate sub-declarator)))
-                (c-item
-                 (error "A random C-ITEM ~S as C-FUNCTION sub-declarator, really?"
-                        sub-declarator))
-                (t ;; raw declarator-id
-                 (generate sub-declarator)))
-              (with-parens "()"
-                (generate-list ","
-                               (function generate)
-                               parameters))
-              (when const    (emit " " "const"))
-              (when volatile (emit " " "volatile"))
-              (when (slot-boundp self 'throw-list)
-                (emit " " "throw" " ")
-                (with-parens "()"
-                  (generate-list ","
-                                 (function generate)
-                                 throw-list)))))
+;; (define-declarator c-function (sub-declarator
+;;                                parameters
+;;                                &key (const nil) (volatile nil) ((:throw throw-list) nil))
+;;   :generate (progn
+;;               (typecase sub-declarator
+;;                 ;; or use some *priority* and priority
+;;                 ((or c-function c-vector        ; direct-declarator
+;;                      expr-scope absolute-scope) ; declarator-id
+;;                  (generate sub-declarator))
+;;                 (declarator
+;;                  (with-parens "()"
+;;                    (generate sub-declarator)))
+;;                 (c-item
+;;                  (error "A random C-ITEM ~S as C-FUNCTION sub-declarator, really?"
+;;                         sub-declarator))
+;;                 (t ;; raw declarator-id
+;;                  (generate sub-declarator)))
+;;               (with-parens "()"
+;;                 (generate-list ","
+;;                                (function generate)
+;;                                parameters))
+;;               (when const    (emit " " "const"))
+;;               (when volatile (emit " " "volatile"))
+;;               (when (slot-boundp self 'throw-list)
+;;                 (emit " " "throw" " ")
+;;                 (with-parens "()"
+;;                   (generate-list ","
+;;                                  (function generate)
+;;                                  throw-list)))))


 ;;;; THE END ;;;;
diff --git a/languages/linc/com.informatimago.languages.linc.asd b/languages/linc/com.informatimago.languages.linc.asd
index 7c4c995..6f7f0cd 100644
--- a/languages/linc/com.informatimago.languages.linc.asd
+++ b/languages/linc/com.informatimago.languages.linc.asd
@@ -55,7 +55,7 @@ generate a corresponding C source.
   :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
   :licence "AGPL3"
   ;; component attributes:
-  :version "1.2.0"
+  :version "1.3.0"
   :properties ((#:author-email                   . "pjb@informatimago.com")
                (#:date                           . "2007")
                ((#:albert #:output-dir)          . "../documentation/com.informatimago.linc/")
@@ -63,14 +63,21 @@ generate a corresponding C source.
                ((#:albert #:docbook #:template)  . "book")
                ((#:albert #:docbook #:bgcolor)   . "white")
                ((#:albert #:docbook #:textcolor) . "black"))
-  :depends-on ("split-sequence"
+  :depends-on ("babel"
                "closer-mop"
+               "split-sequence"
                "com.informatimago.common-lisp.cesarum")
   :components ((:file "packages")
+               (:file "c-string-reader"    :depends-on ("packages"))
+               (:file "readtable"          :depends-on ("packages" "c-string-reader"))
                (:file "c-syntax"           :depends-on ("packages"))
                (:file "c-operators"        :depends-on ("packages" "c-syntax"))
                ;; Not yet (:file "c++-syntax"         :depends-on ("packages"))
-               (:file "linc"               :depends-on ("packages" "c-syntax" "c-operators")))
+               ;; (:file "linc"               :depends-on ("packages" "c-syntax" "c-operators"))
+               (:file "c-runtime"          :depends-on ("packages"))
+               (:file "c-sexp-loader"      :depends-on ("packages" "readtable" "c-runtime"))
+               (:file "c-sexp-compiler"    :depends-on ("packages" "readtable" "c-runtime"))
+               (:file "c-sexp-translator"  :depends-on ("packages" "readtable")))
   #+asdf-unicode :encoding #+asdf-unicode :utf-8
   #+adsf3 :in-order-to #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.linc.test"))))

diff --git a/languages/linc/indent.el b/languages/linc/indent.el
new file mode 100644
index 0000000..bf8c1e7
--- /dev/null
+++ b/languages/linc/indent.el
@@ -0,0 +1,101 @@
+;;;; .sexph and .sexpc
+
+
+(dolist (sym '(do))
+  (cl-indent sym 0))
+
+(dolist (sym '(declare-structure declare-union declare-type
+               declare-enumeration declare-constant declare-variable declare-function
+               define-constant define-variable define-macro
+               .ifndef .ifdef .if
+               \#ifndef \#ifdef \#if
+
+               block))
+  (cl-indent sym 1))
+
+
+
+
+(cl-indent 'define-function 4)
+
+(dolist (sym '(declare-structure declare-union declare-enumeration declare-type))
+  (setf (get sym 'lisp-define-type) 'type))
+
+(dolist (sym '(declare-constant declare-variable define-constant define-variable))
+  (setf (get sym 'lisp-define-type) 'var))
+
+
+;; (re-search-forward "(\\([ \t]*\\|\\(\\s_\\|\\w\\)+:\\)?\\(declare-\\(structure\\|union\\|enumeration\\|constant\\|variable\\|function\\)\\|define-\\(constant\\|variable\\|function\\|macro\\)\\)\\_>[ \t\n]+\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\|\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)?")
+
+(font-lock-add-keywords
+ 'lisp-mode
+ '(("(\\([ \t]*\\|\\(\\s_\\|\\w\\)+:\\)?\\(declare-\\(structure\\|union\\|enumeration\\|type\\|constant\\|variable\\|function\\)\\|define-\\(constant\\|variable\\|function\\|macro\\)\\)\\_>[ \t\n]+\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\|\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)?"
+    (1 font-lock-keyword-face)
+    (3 (let ((type (get (intern-soft (match-string 1)) (quote lisp-define-type))))
+         (cond ((eq type (quote var))  font-lock-variable-name-face)
+               ((eq type (quote type)) font-lock-type-face)
+               ((or (not (match-string 2))
+                    (and (match-string 2) (match-string 4)))
+                font-lock-function-name-face)
+               (t t)))))))
+
+
+;; (setf font-lock-keywords
+;;       '(t (("\\<[Rr][Kk]:\\sw\\sw+\\>" 0 font-lock-builtin-face)
+;;            ("(\\(\\<[-A-Za-z0-9]+-define-[-A-Za-z0-9]+\\>\\)" 1 font-lock-keyword)
+;;            ("(\\([ 	]*\\|\\(\\s_\\|\\w\\)+:\\)?\\(declare-\\(structure\\|union\\|enumeration\\|type\\|constant\\|variable\\|function\\)\\|define-\\(constant\\|variable\\|function\\|macro\\)\\)\\_>[
+;; ]+\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\|\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)?"
+;;             (1 font-lock-keyword-face)
+;;             (3 (let ((type (get (intern-soft (match-string 1))
+;;                                 (quote lisp-define-type))))
+;;                  (match-string 1)
+;;                  (intern-soft (match-string 1)))
+;;                (cond ((eq type (quote var)) font-lock-variable-name-face)
+;;                      ((eq type (quote type)) font-lock-type-face)
+;;                      ((or (not (match-string 2))
+;;                           (and (match-string 2)
+;;                                (match-string 4))) font-lock-function-name-face)
+;;                      (t t))))
+;;            (slime-search-suppressed-forms 0 (quote slime-reader-conditional-face) t)
+;;            ("(\\(\\(\\s_\\|\\w\\)*:\\(define-\\|do-\\|with-\\|without-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+;;            ("(\\(\\(define-\\|do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+;;            ("(\\(check-\\(\\s_\\|\\w\\)*\\)" 1 font-lock-warning-face)
+;;            ("(\\(assert-\\(\\s_\\|\\w\\)*\\)" 1 font-lock-warning-face)
+;;            (mm/match-labels
+;;             (1 font-lock-keyword-face nil)
+;;             (2 font-lock-function-name-face nil t)
+;;             (3 font-lock-function-name-face nil t)
+;;             (4 font-lock-function-name-face nil t)
+;;             (5 font-lock-function-name-face nil t)
+;;             (6 font-lock-function-name-face nil t)
+;;             (7 font-lock-function-name-face nil t)
+;;             (8 font-lock-function-name-face nil t))
+;;            ("(\\(def\\(?:c\\(?:lass\\|onstant\\)\\|generic\\|ine-\\(?:co\\(?:mpiler-macro\\|ndition\\)\\|m\\(?:ethod-combination\\|odify-macro\\)\\|s\\(?:etf-expander\\|ymbol-macro\\)\\)\\|m\\(?:acro\\|ethod\\)\\|pa\\(?:ckage\\|rameter\\)\\|s\\(?:etf\\|\\(?:truc\\|ubs\\)t\\)\\|type\\|un\\|var\\)\\)\\_>[ 	']*\\(([ 	']*\\)?\\(\\(setf\\)[ 	]+\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\|\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)?"
+;;             (1 font-lock-keyword-face)
+;;             (3 (let ((type (get (intern-soft (match-string 1))
+;;                                 (quote lisp-define-type))))
+;;                  (cond ((eq type (quote var)) font-lock-variable-name-face)
+;;                        ((eq type (quote type)) font-lock-type-face)
+;;                        ((or (not (match-string 2))
+;;                             (and (match-string 2)
+;;                                  (match-string 4))) font-lock-function-name-face))) nil t))
+;;            ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+;;            ("(\\(b\\(?:\\(?:loc\\|rea\\)k\\)\\|c\\(?:ase\\|case\\|o\\(?:mpiler-let\\|nd\\(?:ition-case\\)?\\)\\|typecase\\)\\|d\\(?:e\\(?:cla\\(?:im\\|re\\)\\|structuring-bind\\)\\|o\\(?:\\*\\|list\\|times\\)?\\)\\|e\\(?:case\\|typecase\\|val-when\\)\\|flet\\*?\\|go\\|handler-\\(?:bind\\|case\\)\\|i\\(?:f\\|gnore-errors\\|n-package\\)\\|l\\(?:a\\(?:bels\\|mbda\\)\\|et[*f]?\\|o\\(?:cally\\|op\\)\\)\\|m\\(?:acrolet\\|ultiple-value-\\(?:bind\\|prog1\\)\\)\\|pro\\(?:claim\\|g[*12nv]?\\)\\|re\\(?:start-\\(?:bind\\|case\\)\\|turn\\(?:-from\\)?\\)\\|symbol-macrolet\\|t\\(?:agbody\\|\\(?:h\\|ypecas\\)e\\)\\|un\\(?:less\\|wind-protect\\)\\|w\\(?:h\\(?:en\\|ile\\)\\|ith-\\(?:accessors\\|co\\(?:mpilation-unit\\|ndition-restarts\\)\\|hash-table-iterator\\|input-from-string\\|o\\(?:pen-\\(?:file\\|stream\\)\\|utput-to-string\\)\\|package-iterator\\|s\\(?:imple-restart\\|lots\\|tandard-io-syntax\\)\\)\\)\\)\\_>" . 1)
+;;            ("(\\(catch\\|throw\\|provide\\|require\\)\\_>[ 	']*\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)?"
+;;             (1 font-lock-keyword-face)
+;;             (2 font-lock-constant-face nil t))
+;;            ("(\\(a\\(?:\\(?:bo\\|sse\\)rt\\)\\|c\\(?:error\\|heck-type\\)\\|error\\|signal\\|warn\\)\\_>"
+;;             (1 font-lock-warning-face))
+;;            ("[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)['’]"
+;;             (1 font-lock-constant-face prepend))
+;;            ("\\_<:\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\_>"
+;;             (0 font-lock-builtin-face))
+;;            ("\\_<\\&\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\_>" . font-lock-type-face)
+;;            (lisp--match-hidden-arg
+;;             (0 (quote (face font-lock-warning-face help-echo "Hidden behind deeper element; move to another line?"))))
+;;            ("\\<[Rr][Kk]:\\sw\\sw+\\>"
+;;             (0 font-lock-builtin-face))
+;;            ("(\\(\\<[-A-Za-z0-9]+-define-[-A-Za-z0-9]+\\>\\)"
+;;             (1 font-lock-keyword)))))
+
+;;;; THE END ;;;;
diff --git a/languages/linc/linc.lisp b/languages/linc/linc.lisp
index 13add1b..fe62489 100644
--- a/languages/linc/linc.lisp
+++ b/languages/linc/linc.lisp
@@ -457,8 +457,7 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
          com.informatimago.languages.linc.c::>>
          com.informatimago.languages.linc.c::+
          com.informatimago.languages.linc.c::-
-         com.informatimago.languages.linc.c::*
-         com.informatimago.languages.linc.c::/
+         com.informatimago.languages.linc.c::*\\         com.informatimago.languages.linc.c::/
          com.informatimago.languages.linc.c::%
          com.informatimago.languages.linc.c::.*
          com.informatimago.languages.linc.c::->*
diff --git a/languages/linc/loader.lisp b/languages/linc/loader.lisp
index 9bf9417..389f149 100644
--- a/languages/linc/loader.lisp
+++ b/languages/linc/loader.lisp
@@ -33,6 +33,7 @@
 ;;;;**************************************************************************
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf *readtable* (copy-readtable nil)))
+(in-package "COMMON-LISP-USER")

 (unless (find-package :split-sequence)
   (asdf:operate 'asdf:load-op :split-sequence))
diff --git a/languages/linc/notes.org b/languages/linc/notes.org
index 3419d22..efde700 100644
--- a/languages/linc/notes.org
+++ b/languages/linc/notes.org
@@ -1,6 +1,125 @@
 * Specifications
-
 ** linc syntax
+*** preprocessing-tokens
+**** #include
+
+#+BEGIN_EXAMPLE
+(include <foo.h>|"foo.h" …)
+#+END_EXAMPLE
+
+**** rest
+In (#… ) expressions pp-tokens are sequences of symbol, integers
+floating-point numbers or strings.  Depending on the # operator, the
+strings are taken literally, or assumed to contain the text to be used
+in the generation of the operator.
+
+This may lead to the need of escaping strings in strings in some cases.
+
+#+BEGIN_EXAMPLE
+(#define foo "bar baz")
+-->
+#define foo bar baz
+
+(#define foo "bar \"baz\"")
+-->
+#define foo bar "baz"
+
+(#include "foo.h")
+-->
+#includle "foo.h"
+
+(#include <foo.h>)
+-->
+#include <foo.h>
+#+END_EXAMPLE
+
+
+#+BEGIN_EXAMPLE
+    (#define foo         "bar baz")
+    (#define foo (x)     "bar x baz")
+    (#define foo (x ...) "bar VA_ARGS baz")
+    (#undef foo)
+    (#line "file.c" 33
+    (#line 42
+    (#error "Not implemented yet")
+    (#pragma foo 42 "bar baz")
+    (#)
+
+    ;; #if/#ifdef/#ifndef
+    (#if condition
+      (c-code)
+     #elif condition
+      (c-code)
+     #else
+      (c-code))
+
+    ;; #cond
+    (#cond
+      (condition (c-code))
+      (condition (c-code))
+      (t         (c-code)))
+
+    ;; condition can be (defined foo)
+#+END_EXAMPLE
+
+*** other
+
+#+BEGIN_EXAMPLE
+We don't allow:
+
+INVALID:
+                (function (x y z) -> int)
+
+for function types,
+and we don't allow:
+
+INVALID:
+                (declare-function name (x y z) -> int
+                      (declare-variable x int)
+                      (declare-variable y int)
+                      (declare-variable z int)
+                   (block (return (+ x y z))))
+for declarations.
+
+But (function (int float) -> int)
+is valid as is (function ((x int) (y float)) -> int)
+But for multi-word types, they must have to be in parenthesis:
+   (function ((long int) (short int)) -> int)
+#+END_EXAMPLE
+*** statements
+  (break)
+  (continue)
+  (label foo)
+  (goto foo)
+  (asm "string")
+  (return [expression])
+
+  (switch expression
+    (case val1
+      stmts)
+    (case val2
+      stmts)
+    (default
+     stmts))
+  (block
+      stmts…)
+  (if expression
+      stmts
+      [stmts])
+  (while expression
+    stmts…)
+  (do
+   stmts…
+   while expression)
+  (for (init test incr)
+    stmts…)
+
+  (let (bindings…)
+    stmts)
+  (let* (bindings…)
+    stmts)
+  (cond
+    (()))

 ** Usage

@@ -12,7 +131,6 @@ Linc forms can be either translated to C source ie. "compiled",
 or "interpreted" directly in lisp, for development and debugging purpose,
 with some limitations on use of external C objects (CFFI can be used).

-
 #+BEGIN_EXAMPLE
 (defparameter *c-source* '#{

@@ -41,6 +159,14 @@ linc-compile-file (input-file &key verbose print
 #+END_EXAMPLE


+Each syntactic element is represented by:
+- a lisp class,
+- with a PRINT-OBJECT method to output the constructor form,
+- with a constructor to make an instance.
+- with a C-SEXP method to output the C sexp,
+- with a GENERATE method to emit the C code,
+- the C sexp operator is interned in COM.INFORMATIMAGO.LANGUAGES.LINC.C, and is aliased to the contructor.
+
 * README

 Mon Jul  2 19:28:51 CEST 2012
@@ -48,8 +174,6 @@ Mon Jul  2 19:28:51 CEST 2012
 This project is published as-is.
 It is far from finished.

-
-
 Tue Oct  4 16:14:25 CEST 2005

 Let's start a linc project.
@@ -905,3 +1029,174 @@ Each syntactic element is represented by:
 - with a GENERATE method to emit the C code,
 - the C sexp operator is interned in COM.INFORMATIMAGO.LANGUAGES.LINC.C, and is aliased to the contructor.

+
+#+BEGIN_EXAMPLE
+
+
+    ("(6.7.1)" storage-class-specifier -->
+     |typedef|
+     |extern|
+     |static|
+     |_Thread_local|
+     |auto|
+     |register|)
+
+    ("(6.7.2)" type-specifier -->
+     |void|
+     |char|
+     |short|
+     |int|
+     |long|
+     |float|
+     |double|
+     |signed|
+     |unsigned|
+     |_Bool|
+     |_Complex|
+     atomic-type-specifier
+     struct-or-union-specifier
+     enum-specifier
+     typedef-name)
+
+    ("(6.7.3)" type-qualifier -->
+     |const|
+     |restrict|
+     |volatile|
+     |_Atomic|)
+
+
+    ("(6.7.4)" function-specifier -->
+     |inline|
+     |_Noreturn|)
+
+    ("(6.7.5)" alignment-specifier -->
+     (|_Alignas| \( type-name \))
+     (|_Alignas| \( constant-expression \)))
+
+    ("(6.7.6)" declarator -->
+     ((opt pointer) direct-declarator))
+
+
+declarations:
+
+     (storage-class-specifier (opt declaration-specifiers) (opt init-declararator) \;)
+     (type-specifier          (opt declaration-specifiers) (opt init-declararator) \;)
+     (type-qualifier          (opt declaration-specifiers) (opt init-declararator) \;)
+     (function-specifier      (opt declaration-specifiers) (opt init-declararator) \;)
+     (alignment-specifier     (opt declaration-specifiers) (opt init-declararator) \;)
+     static_assert-declaration
+
+declarator:
+     ((opt pointer) direct-declarator))
+
+direct-declarator:
+     identifier
+     (\( declarator \))
+     (direct-declarator \[ (opt type-qualifier-list) (opt assignment-expression) \])
+     (direct-declarator \[ static (opt type-qualifier-list) assignment-expression \])
+     (direct-declarator \[ type-qualifier-list static assignment-expression \])
+     (direct-declarator \[ (opt type-qualifier-list) \* \])
+     (direct-declarator \( parameter-type-list \))
+     (direct-declarator \( (opt identifier-list) \)))
+
+
+
+#+END_EXAMPLE
+
+
+
+toplevel forms:
+
+#+BEGIN_EXAMPLE
+
+(include <file>)
+(include "file")
+
+(declare-structure   name slots)
+(declare-union       name alternatives)
+(declare-type        name type)
+(declare-enumeration name values)
+
+(declare-constant    name type)
+(define-constant     name type value)
+
+(declare-variable    name type)
+(define-variable     name type value)
+
+(declare-function    name lambda-list type [inline] [noreturn])
+(define-function     name lambda-list type [inline] [noreturn] &body body)
+
+(define-macro        name [lambda-list] expansion-string)
+
+
+// future?
+
+(declare-constant    name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type)
+(define-constant     name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type value)
+
+(declare-variable    name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type)
+(define-variable     name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type value)
+
+(declare-function    name [extern] [static] [thread-local] [inline] [noreturn] lambda-list type)
+(define-function     name [extern] [static] [thread-local] [inline] [noreturn] lambda-list type &body body)
+
+(define-macro        name [lambda-list] expansion)
+
+#+END_EXAMPLE
+
+
+|---------------+---------|
+| typedef       | typ     |
+|---------------+---------|
+| extern        | var fun |
+| static        | var fun |
+|---------------+---------|
+| _Thread_local | var     |
+| auto          | var     |
+| register      | var     |
+
+
+|----------+-----|
+| const    | typ |
+| restrict | typ |
+| volatile | typ |
+| _Atomic  | typ |
+
+
+| c        | lisp     |
+|----------+----------|
+| void     | void     |
+| char     | char     |
+| short    | short    |
+| int      | int      |
+| long     | long     |
+| float    | float    |
+| double   | double   |
+| signed   | signed   |
+| unsigned | unsigned |
+| _Bool    | bool     |
+| _Complex | complex  |
+
+|--------------------+---|
+| void               | 0 |
+|--------------------+---|
+| bool               |   |
+| float              |   |
+| double             |   |
+| complex            |   |
+|--------------------+---|
+| char               | 1 |
+| signed char        | 1 |
+| unsigned char      | 1 |
+| short              | 2 |
+| signed short       | 2 |
+| unsigned short     | 2 |
+| int                | 4 |
+| signed int         | 4 |
+| unsigned int       | 4 |
+| long               | 8 |
+| signed long        | 8 |
+| unsigned long      | 8 |
+| long long          | 8 |
+| signed long long   | 8 |
+| unsigned long long | 8 |
diff --git a/languages/linc/packages.lisp b/languages/linc/packages.lisp
index 39b5729..a3822d4 100644
--- a/languages/linc/packages.lisp
+++ b/languages/linc/packages.lisp
@@ -16,7 +16,7 @@
 ;;;;LEGAL
 ;;;;    AGPL3
 ;;;;
-;;;;    Copyright Pascal J. Bourguignon 2007 - 2016
+;;;;    Copyright Pascal J. Bourguignon 2007 - 2019
 ;;;;
 ;;;;    This program is free software: you can redistribute it and/or modify
 ;;;;    it under the terms of the GNU Affero General Public License as published by
@@ -31,23 +31,173 @@
 ;;;;    You should have received a copy of the GNU Affero General Public License
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************
+(cl:in-package "COMMON-LISP-USER")
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf *readtable* (copy-readtable nil)))

+
+(defpackage "COM.INFORMATIMAGO.LANGUAGES.LINC.C-RUNTIME.STDIO"
+  (:use "COMMON-LISP")
+  (:export "printf" "fopen" "fread" "fwrite" "fseek" "ftell" "fclose"))
+
+(defpackage "COM.INFORMATIMAGO.LANGUAGES.LINC.C-RUNTIME"
+  (:use "COMMON-LISP")
+  (:export "INITIALIZE")
+  (:export "ENVIRONMENT" "VARIABLE" "ARRAY" "POINTER"))
+
+
 (defpackage "COM.INFORMATIMAGO.LANGUAGES.LINC.C"
   (:nicknames "COM.INFORMATIMAGO.LANGUAGES.LINC.C++")
-  (:use))
+  (:use)
+  (:export
+   ;; pre-processor directives
+   "include"
+   "#ifdef"
+   "#ifndef"
+   "#if"
+   "#elif"
+   "#else"
+
+   ;; toplevel forms
+   "declare-structure"
+   "declare-union"
+   "declare-type"
+   "declare-enumeration"
+   "declare-constant"
+   "declare-variable"
+   "declare-function"
+
+   "define-constant"
+   "define-variable"
+   "define-function"
+   "define-macro"
+
+   ;; statements:
+   "label" "goto"
+   "switch" "case" "default"
+   "block" "let" "let*"
+   "if" "while" "do" "for"
+   "break" "continue" "return"
+   "asm"
+
+   ;; anyary operator:
+   "progn"
+   ;; ternary operator:
+   "?"
+   ;; binary operators:
+   "=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "|=" "^="
+   "||" "&&" "|" "^" "&" "==" "!=" "<" ">" "<=" ">=" "<<" ">>"
+   "+" "-" "*" "/" "%" ".*" "->*"
+   "." "->" "aref"
+   ;; unary operators:
+   "++" "--" "!" "~"
+   "&" "sizeof"
+   "post++" "post--"
+   ;; +, - and * can be used as unary operators too.
+   "cast" ","
+
+   ;; types
+   ;; "typedef"
+   "extern" "static" "thread-local" "auto" "register" "const"
+   "restrict" "volatile" "atomic" "void" "char" "short" "int" "long"
+   "float" "double" "signed" "unsigned" "bool" "complex" "struct" "enum"
+   "union" "atomic" "pointer" "array" "function"
+   "bit"
+   "inline" "noreturn"
+
+   ;; ;; c++ extensions (not implemented yet).
+   ;; "external"
+   ;; "using" "namespace" "typename" "template"
+   "new" "new[]" "delete" "delete[]"
+   "::"
+   ;; "absolute-scope" "scope"
+   ))
+
+(defpackage "COM.INFORMATIMAGO.LANGUAGES.LINC.C-SEXP-LANGUAGE"
+  (:use "COMMON-LISP")
+  (:export "INCLUDE"
+
+           "DECLARE-STRUCTURE"
+           "DECLARE-UNION"
+           "DECLARE-TYPE"
+           "DECLARE-ENUMERATION"
+           "DECLARE-CONSTANT"
+           "DECLARE-VARIABLE"
+           "DECLARE-FUNCTION"
+
+           "DEFINE-CONSTANT"
+           "DEFINE-VARIABLE"
+           "DEFINE-FUNCTION"
+           "DEFINE-MACRO"
+
+           ;; Statemetns:
+           "LABEL" "GOTO"
+           "SWITCH" "CASE" "DEFAULT"
+           "BLOCK" "LET" "LET*"
+           "IF" "WHILE" "DO" "FOR"
+           "BREAK" "CONTINUE" "RETURN"
+           "ASM"
+
+           ;;
+           "EXPORT"
+
+           ;; Anyary operator:
+           "PROGN"
+           ;; Ternary operator:
+           "?"
+           ;; Binary operators:
+           "=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "|=" "^="
+           "||" "&&" "|" "^" "&" "==" "!=" "<" ">" "<=" ">=" "<<" ">>"
+           "+" "-" "*" "/" "%" ".*" "->*"
+           "." "->" "AREF"
+           ;; Unary operators:
+           "++" "--" "!" "~"
+           "&" "SIZEOF"
+           "POST++" "POST--"
+           ;; +, - and * can be used as unary operators too.
+
+           "CAST" ","
+           "BIT" "INLINE" "NORETURN"
+
+           ;; C++ extensions (not implemented yet).
+           "EXTERN"
+           "USING" "NAMESPACE" "TYPENAME" "TEMPLATE"
+           "NEW" "NEW[]" "DELETE" "DELETE[]"
+           "::"
+           "ABSOLUTE-SCOPE" "SCOPE")
+
+  (:shadow "CASE" "BLOCK" "LET" "IF" "DO"
+           "BREAK" "CONTINUE" "RETURN"
+
+           "=" "/=" "<" ">" "<=" ">=" "+" "-" "*" "/" "++"
+           "AREF"))

 (defpackage "COM.INFORMATIMAGO.LANGUAGES.LINC"
-  (:use "COMMON-LISP"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
+  (:use "COMMON-LISP")
+  (:shadow "TYPEP" "FUNCTIONP")
+  (:use "SPLIT-SEQUENCE")
+  (:use "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
+  (:shadow "INCLUDE-FILE")
+  (:use "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL"
         "COM.INFORMATIMAGO.COMMON-LISP.LISP-SEXP.SOURCE-FORM")
-  (:shadow "DECLARATION" "THROW")
-  (:export
-   "COMPILE-LINC-FILE"))
+  (:use "COM.INFORMATIMAGO.LANGUAGES.LINC.C")
+  (:shadowing-import-from "COMMON-LISP"
+                          "+" "-" "*" "/"
+                          "<" ">" "<=" ">="
+                          "=" "/="
+                          "++")
+  (:export "COMPILE-LINC-FILE"
+           "LOAD-LINC-FILE"
+           "TRANSLATE-LINC-FILE"))
+
+(in-package  "COM.INFORMATIMAGO.LANGUAGES.LINC")

+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *c-package-name*  "COM.INFORMATIMAGO.LANGUAGES.LINC.C")
+  (defvar *c-opening-brace* #\{)
+  (defvar *c-closing-brace* #\})
+  (defvar *c-progn*         '|progn|))

 ;;;; THE END ;;;;
diff --git a/languages/linc/readtable-test.lisp b/languages/linc/readtable-test.lisp
new file mode 100644
index 0000000..148c7fc
--- /dev/null
+++ b/languages/linc/readtable-test.lisp
@@ -0,0 +1,72 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+
+(defun test/reader-c-sexp-list ()
+  (assert (equal
+           (with-input-from-string (input "
+        (sscanf b \"%d\" (address bv))
+        (sprintf res \"%d\" (+ a b))
+        (return res)
+   })")
+             (read-c-sexp-list input))
+           '((com.informatimago.languages.linc.c::|sscanf| com.informatimago.languages.linc.c::\b "%d"
+              (com.informatimago.languages.linc.c::|address| com.informatimago.languages.linc.c::|bv|))
+             (com.informatimago.languages.linc.c::|sprintf| com.informatimago.languages.linc.c::|res| "%d"
+              (com.informatimago.languages.linc.c::+ com.informatimago.languages.linc.c::\a
+               com.informatimago.languages.linc.c::\b))
+             (com.informatimago.languages.linc.c::|return| com.informatimago.languages.linc.c::|res|))))
+  :success)
+
+(defun test/read-ellipsis ()
+  (map nil (lambda (result expected)
+             (if (find expected #(simple-stream-error))
+                 (assert (cl:typep result expected))
+                 (assert (cl:equal result expected))))
+
+       (mapcar (lambda (string)
+                 (with-input-from-string (input string)
+                   (read-char input)
+                   (handler-case (read-ellipsis input)
+                     (error (err) err))))
+               '(". a b c"
+                 ".;hello d e"
+                 ".#foo d e"
+                 ".abc d e"
+
+                 ".. a b c"
+                 "..;hello d e"
+                 "..#foo d e"
+                 "..abc d e"
+
+                 "... a b c"
+                 "...;hello d e"
+                 "...#foo d e"
+                 "...abc d e"))
+
+       '(|.| |.| |.#FOO| .abc simple-stream-error simple-stream-error ..\#FOO ..abc |...| |...| ...\#FOO ...abc))
+  :success)
+
+(enable-c-sexp-reader-macros)
+
+#-(and) (defparameter *c-source* '#{
+
+                            (define-function string_add ((a (char *)) (b (char *))) (char *)
+                              (let ((av int)
+                                    (bv int)
+                                    (res (char *) (malloc (+ 2 (max (strlen a) (strlen b))))))
+                                (sscanf a "%d" (address av))
+                                (sscanf b "%d" (address bv))
+                                (sprintf res "%d" (+ a b))
+                                (return res)))
+
+                            })
+
+;; (print-c-sexp-form *c-source*)
+
+(defun test/all ()
+  (test/reader-c-sexp-list)
+  (test/read-ellipsis))
+
+(test/all)
diff --git a/languages/linc/readtable.lisp b/languages/linc/readtable.lisp
index 362e16f..7992d66 100644
--- a/languages/linc/readtable.lisp
+++ b/languages/linc/readtable.lisp
@@ -1,16 +1,20 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
 (in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")

-(defvar *c-readtable*
+(define-condition simple-stream-error (stream-error simple-condition)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "~?"
+                     (simple-condition-format-control condition)
+                     (simple-condition-format-arguments condition)))))
+
+(defparameter *c-readtable-without-reader-macros*
   (let ((rt (copy-readtable nil)))
     (setf (readtable-case rt) :preserve)
-    rt)
-  "Readtable to read S-expified C code.")
+    rt))

-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *c-package-name*  "COM.INFORMATIMAGO.LANGUAGES.LINC.C")
-  (defvar *c-opening-brace* 'COM.INFORMATIMAGO.LANGUAGES.LINC.C::\{ )
-  (defvar *c-closing-brace* 'COM.INFORMATIMAGO.LANGUAGES.LINC.C::\} )
-  (defvar *c-progn*         'COM.INFORMATIMAGO.LANGUAGES.LINC.C::|progn| ))
+(defvar *c-readtable*)

 (defun read-c-sexp-list (stream)
   (let ((*package*   (load-time-value (find-package *c-package-name*)))
@@ -46,33 +50,58 @@
   (declare (ignore ch sub))
   (cons *c-progn* (read-c-sexp-list stream)))

-(defmacro enable-c-sexp-reader-macros ()
+(defparameter *c-spaces* #(#\space #\tab #\newline #\page))
+
+(defun read-dot-and-ellipsis (stream)
+  (let ((buffer (make-array 80 :element-type 'character
+                               :fill-pointer 0
+                               :adjustable t)))
+    (vector-push #\. buffer)
+    (loop
+      :for ch := (peek-char nil stream)
+      :while (char= #\. ch)
+      :do (vector-push-extend (read-char stream) buffer)
+      :finally (return
+                 (multiple-value-bind (fun non-terminating-p) (get-macro-character ch)
+                   (if (if fun non-terminating-p (not (find ch *c-spaces*)))
+                       (with-input-from-string (buffer-stream buffer)
+                         (let ((input (make-concatenated-stream buffer-stream stream))
+                               (*readtable* *c-readtable-without-reader-macros*))
+                           (read input)))
+                       (case (length buffer)
+                         ((1 3) (intern buffer))
+                         (otherwise (error 'simple-stream-error
+                                           :stream stream
+                                           :format-control "Invalid token ~S"
+                                           :format-arguments (list buffer))))))))))
+
+(defun reader-macro-dot-and-ellipsis (stream ch)
+  (declare (ignore ch))
+  (read-dot-and-ellipsis stream))
+
+(defmacro enable-c-sexp-reader-macros (&optional (readtable '*readtable*))
   `(eval-when (:compile-toplevel :load-toplevel :execute)
-     (set-macro-character #.(character *c-opening-brace*)
+     (set-macro-character #\"
+                          (function read-c-string)
+                          nil
+                          ,readtable)
+     (set-macro-character #\.
+                          (function reader-macro-dot-and-ellipsis)
+                          t
+                          ,readtable)
+     (set-macro-character *c-opening-brace*
                           (function reader-macro-c-sexp-list)
                           nil
-                          *readtable*)
-     (set-dispatch-macro-character #\# #.(character *c-opening-brace*)
+                          ,readtable)
+     (set-dispatch-macro-character #\# *c-opening-brace*
                                    (function reader-dispatching-macro-c-sexp-list)
-                                   *readtable*)))
-
-(defun test/reader-c-sexp-list ()
-  (assert (equal
-           (with-input-from-string (input "
-        (sscanf b \"%d\" (address bv))
-        (sprintf res \"%d\" (+ a b))
-        (return res)
-   })")
-             (read-c-sexp-list input))
-           '((com.informatimago.languages.linc.c::|sscanf| com.informatimago.languages.linc.c::\b "%d"
-              (com.informatimago.languages.linc.c::|address| com.informatimago.languages.linc.c::|bv|))
-             (com.informatimago.languages.linc.c::|sprintf| com.informatimago.languages.linc.c::|res| "%d"
-              (com.informatimago.languages.linc.c::+ com.informatimago.languages.linc.c::\a
-               com.informatimago.languages.linc.c::\b))
-             (com.informatimago.languages.linc.c::|return| com.informatimago.languages.linc.c::|res|))))
-  :success)
-
+                                   ,readtable)))

+(defparameter *c-readtable*
+  (let ((rt (copy-readtable *c-readtable-without-reader-macros*)))
+    (enable-c-sexp-reader-macros rt)
+    rt)
+  "Readtable to read S-expified C code.")

 (defun print-c-sexp-form (form &optional (*standard-output* *standard-output*))
   (let ((*package* (load-time-value (find-package *c-package-name*)))
@@ -84,26 +113,4 @@
     (write-line "}")
     (values)))

-;;; ----------------------------------------
-
-(test/reader-c-sexp-list)
-
-(enable-c-sexp-reader-macros)
-
-(defparameter *c-source* '#{
-
-                            (define-function string_add ((a (char *)) (b (char *))) (char *)
-                              (let ((av int)
-                                    (bv int)
-                                    (res (char *) (malloc (+ 2 (max (strlen a) (strlen b))))))
-                                (sscanf a "%d" (address av))
-                                (sscanf b "%d" (address bv))
-                                (sprintf res "%d" (+ a b))
-                                (return res)))
-
-                            })
-
-;; (print-c-sexp-form *c-source*)
-
-
-
+;;;; THE END ;;;;
diff --git a/languages/linc/run.lisp b/languages/linc/run.lisp
new file mode 100644
index 0000000..d87f904
--- /dev/null
+++ b/languages/linc/run.lisp
@@ -0,0 +1,8 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(translate-linc-file "test-include.sexpc" :print t :verbose t)
+
+(cc (translate-linc-file "test-types.sexpc" :print t :verbose t)
+    :output "test-types.o" :to :object :options '("-Werror" "-Wall"))
diff --git a/languages/linc/test-c-array.c b/languages/linc/test-c-array.c
new file mode 100644
index 0000000..cbb33cb
--- /dev/null
+++ b/languages/linc/test-c-array.c
@@ -0,0 +1,9 @@
+#include <stdio.h>
+typedef int aint_t[3];
+aint_t a={1,2,3};
+int main(){
+    for(int i=0;i<3;i++){
+        printf("%d ",a[i]);}
+    printf("\n");
+    return 0;}
+
diff --git a/languages/linc/test-c-empty-struct-union.c b/languages/linc/test-c-empty-struct-union.c
new file mode 100644
index 0000000..686af64
--- /dev/null
+++ b/languages/linc/test-c-empty-struct-union.c
@@ -0,0 +1,14 @@
+#include <stdio.h>
+
+typedef struct {
+} empty_struct;
+
+typedef union {
+} empty_union;
+
+
+int main(){
+    empty_union  u;
+    empty_struct s;
+    return 0;}
+
diff --git a/languages/linc/test-c-struct-bit.c b/languages/linc/test-c-struct-bit.c
new file mode 100644
index 0000000..72e7829
--- /dev/null
+++ b/languages/linc/test-c-struct-bit.c
@@ -0,0 +1,16 @@
+#include <stdio.h>
+
+typedef struct {
+    int a:1,b:2,c:3;
+} s1;
+
+typedef struct {
+    int a:1;
+    int b:2;
+    int c:3;
+} s2;
+
+int main(){
+    printf("sizeof(s1)=%d\n",sizeof(s1));
+    printf("sizeof(s2)=%d\n",sizeof(s2));
+    return 0;}
diff --git a/languages/linc/test-c-syntax.lisp b/languages/linc/test-c-syntax.lisp
deleted file mode 100644
index f455029..0000000
--- a/languages/linc/test-c-syntax.lisp
+++ /dev/null
@@ -1,383 +0,0 @@
-(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
-
-(assert (equal (camel-case (symbol-name 'com.informatimago.languages.linc.c::my-var)
-                           :capitalize-initial nil)
-               "myVar"))
-
-(defmacro check-emited (form expected)
-  `(let ((result (with-output-to-string (*c-out*) ,form)))
-     (assert (equal result ,expected)
-             ()
-             "Evaluating ~S~% returned   ~S~% instead of ~S"
-             ',form result ,expected)))
-
-(check-emited (emit (camel-case (symbol-name 'com.informatimago.languages.linc.c::printf)
-                                :capitalize-initial nil))
-              "printf")
-
-(check-emited (generate 'com.informatimago.languages.linc.c::my-var)
-              "myVar")
-
-(assert (equal (c-sexp 'com.informatimago.languages.linc.c::my-var)
-               ''com.informatimago.languages.linc.c::my-var))
-
-(check-emited (generate "hello world\\r")
-              "\"hello world\\r\"")
-
-(check-emited
- (dolist (x (list 0 -1 1 -128 127 128
-                  -32768 32767 32768
-                  (- (expt 2 31)) (1- (expt 2 31)) (expt 2 31)
-                  (- (expt 2 32)) (1- (expt 2 32)) (expt 2 32)
-                  (- (expt 2 63)) (1- (expt 2 63)) (expt 2 63)
-                  (- (expt 2 64)) (1- (expt 2 64)) (expt 2 64)
-                  (- (expt 2 127)) (1- (expt 2 127)) (expt 2 127)
-                  (- (expt 2 128)) (1- (expt 2 128)) (expt 2 128)))
-   (block go-on
-     (handler-bind ((error (lambda (err)
-                             (declare (ignore err))
-                             ;; (princ err) (terpri)
-                             (return-from go-on))))
-       (generate x)))
-   (emit ", "))
- "0, -1, 1, -128, 127, 128, -32768, 32767, 32768, -2147483648, 2147483647, 2147483648L, -4294967296L, 4294967295L, 4294967296L, -9223372036854775808L, 9223372036854775807L, 9223372036854775808L, -18446744073709551616L, 18446744073709551615L, 18446744073709551616L, -170141183460469231731687303715884105728LL, 170141183460469231731687303715884105727LL, 170141183460469231731687303715884105728LL, -340282366920938463463374607431768211456LL, 340282366920938463463374607431768211455LL, , ")
-
-
-(check-emited (generate pi)
-              "3.141592653589793E+0")
-
-(check-emited (generate (coerce pi 'short-float))
-              "3.1415927E+0F")
-
-(check-emited (generate (coerce (expt pi 130) 'long-float))
-              "4.260724468298572E+64")
-
-(check-emited (generate 123.456l89)
-              "1.23456E+91")
-
-(check-emited (generate #\a)
-              "'a'")
-
-(check-emited (generate #\newline)
-              "'\\12'")
-
-(check-emited (dolist (item (list
-
-                             (expr-seq      (assign 'a 1) (assign 'b 2) (assign 'c 3))
-                             (expr-callargs (assign 'a 1) (assign 'b 2) (assign 'c 3))
-                             (expr-callargs (expr-seq  (assign 'a 1) (assign 'b 2) (assign 'c 3)))
-                             ;; expr-args above expr-seq to force parens in: fun(arg,(f(a),g(b)),arg);
-                             (expr-callargs (assign 'a 1)
-                                            (expr-seq (assign 'b 2) (assign 'c 3)))
-                             (expr-if (expr-eq 'a 1) 2 3)
-                             (assign               'var 42)
-                             (assign-times         'var 42)
-                             (assign-divided       'var 42)
-                             (assign-modulo        'var 42)
-                             (assign-plus          'var 42)
-                             (assign-minus         'var 42)
-                             (assign-right-shift   'var 42)
-                             (assign-left-shift    'var 42)
-                             (assign-bitand        'var 42)
-                             (assign-bitor         'var 42)
-                             (assign-bitxor        'var 42)
-
-                             (expr-logor  (expr-eq 'p 0) (expr-ne 'q 0))
-                             (expr-logand (expr-eq 'p 0) (expr-ne 'q 0))
-                             (expr-bitor  (expr-eq 'p 0) (expr-ne 'q 0))
-                             (expr-bitxor (expr-eq 'p 0) (expr-ne 'q 0))
-                             (expr-bitand (expr-eq 'p 0) (expr-ne 'q 0))
-                             (expr-eq 'p 0)
-                             (expr-ne 'p 0)
-                             (expr-lt 'p 'q)
-                             (expr-le 'p 'q)
-                             (expr-gt 'p 'q)
-                             (expr-ge 'p 'q)
-
-                             (expr-left-shift        'var 42)
-                             (expr-right-shift       'var 42)
-
-                             (expr-plus    'a 'b)
-                             (expr-minus   'a 'b)
-                             (expr-times   'a 'b)
-                             (expr-divided 'a 'b)
-                             (expr-modulo  'a 'b)
-
-                             (expr-memptr-deref    'p 'mem)
-                             (expr-ptrmemptr-deref 'p 'mem)
-
-                             ;; (expr-cast   'p TYPE???)
-
-                             (expr-preincr   'a)
-                             (expr-predecr   'a)
-                             (expr-postincr  'a)
-                             (expr-postdecr  'a)
-                             (expr-lognot    'p)
-                             (expr-bitnot    'q)
-
-                             (expr-deref     'p)
-                             (expr-address   'a)
-                             (expr-deref     (expr-address 'a))
-                             (expr-pos       'a)
-                             (expr-neg       'a)
-                             (expr-sizeof    'a)
-                             (expr-new       'a)
-                             (expr-new[]     'a)
-                             (expr-delete    'a)
-                             (expr-delete[]  'a)
-
-                             (cpp-stringify  'foo)
-
-                             (expr-field   'p 'a)
-                             (expr-field   'p 'a 'b 'c)
-                             (expr-ptrfield   'p 'a)
-                             (expr-ptrfield   'p 'q 'r 'a)
-                             (expr-aref 'a 1 2 3)
-                             (expr-call 'f 1 2 3)
-                             (expr-call 'f (expr-seq 1 2) 3) ;; TODO
-
-                             (absolute-scope 'a)
-                             (expr-scope 'b 'c)
-                             (expr-scope 'a)
-                             (cpp-join 'foo 'bar)
-
-                             ))
-                ;; (print item)
-                ;; (terpri)
-                (generate item)
-                (terpri *c-out*))
-              "a=1,b=2,c=3
-a=1,b=2,c=3
-a=1,b=2,c=3
-a=1,b=2,c=3
-a==1?2:3
-var=42
-var*=42
-var/=42
-var%=42
-var+=42
-var-=42
-var>>=42
-var<<=42
-var&=42
-var|=42
-var^=42
-p==0||q!=0
-p==0&&q!=0
-p==0|q!=0
-p==0^q!=0
-p==0&q!=0
-p==0
-p!=0
-p<q
-p<=q
-p>q
-p>=q
-var<<42
-var>>42
-a+b
-a-b
-a*b
-a/b
-a%b
-p.*mem
-p->*mem
-++a
---a
-a++
-a--
-!p
-~q
-(*(p))
-(&(a))
-(*((&(a))))
-(+(a))
-(-(a))
-sizeof(a)
-new a
-new[] a
-delete a
-delete[] a
-#foo
-p.a
-p.a.b.c
-p->a
-p->q->r->a
-a[1][2][3]
-f(1,2,3)
-f(1,2,3)
-::a
-b::c
-a
-foo##bar
-")
-
-
-
-(check-emited (generate (stmt-expr (assign 'a 1)))
-"
-a=1;
-")
-
-(check-emited (generate (ensure-statement (assign 'a 1)))
-              "a=1;
-")
-
-(check-emited (generate (stmt-label 'foo (ensure-statement (assign 'a 1))))
-              "foo:
-a=1;
-")
-
-(check-emited (generate (stmt-case  'bar (ensure-statement (assign 'a 1))))
-              "case bar:
-a=1;
-")
-
-(check-emited (generate (stmt-default    (ensure-statement (assign 'a 1))))
-              "default:
-a=1;
-")
-
-(check-emited (generate (stmt-block (list
-                                     (ensure-statement (assign 'a 1))
-                                     (ensure-statement (assign 'b 2))
-                                     (ensure-statement (assign 'c 3)))))
-              "{
-    a=1;
-    b=2;
-    c=3;
-}")
-
-
-(check-emited (generate (stmt-let (list
-                                   (ensure-statement (assign 'a 'x))
-                                   (ensure-statement (assign 'b 'y))
-                                   (ensure-statement (assign 'c 'z)))
-                                  (list
-                                   ;; (decl-var 'x 'int 1)
-                                   ;; (decl-var 'y 'int 2)
-                                   ;; (decl-var 'z 'int 2)
-                                   )))
-              "
-{
-a=x;
-b=y;
-c=z;
-}")
-
-
-(check-emited (generate (stmt-if (expr-call 'print 'a)
-                                 (expr-call 'print 'b)
-                                 (expr-eq 'a 'b)))
-              "
-if(a==b)
-    CommonLisp_print(a);
-else
-    CommonLisp_print(b);
-")
-
-(check-emited (generate (stmt-if (expr-call 'print 'a)
-                                 nil
-                                 (expr-eq 'a 'b)))
-              "if(a==b)
-    CommonLisp_print(a);
-")
-
-(check-emited (generate (stmt-switch (stmt-block (list
-                                                  (stmt-case  'foo (ensure-statement (assign 'a 1)))
-                                                  (stmt-break)
-                                                  (stmt-case  'bar (ensure-statement (assign 'a 2)))
-                                                  (stmt-break)
-                                                  (stmt-default    (ensure-statement (assign 'a 3)))))
-                                     (expr-seq 'x)))
-              "switch(x){
-    case foo:
-    a=1;
-    break;
-    case bar:
-    a=2;
-    break;
-    default:
-    a=3;
-}")
-
-(check-emited (generate (stmt-while (ensure-statement (assign-plus 'a 'b))
-                                    (expr-eq 'a 'b)))
-              "
-while(a==b)
-    a+=b;
-")
-
-(check-emited (generate (stmt-do (stmt-block (list (assign-plus 'a 'b)))
-                                 (expr-eq 'a 'b)))
-              "do{
-    a+=b;
-}while(a==b)")
-
-(check-emited (generate (stmt-for (assign 'a '0) (expr-lt 'a '100) (expr-postincr 'a)
-                                  (stmt-block (list (assign-plus 'a 'b)))))
-              "
-for(a=0;a<100;a++){
-    a+=b;
-}")
-
-(check-emited (progn
-                (generate (stmt-break))
-                (generate (stmt-continue))
-                (generate (stmt-return nil))
-                (generate (stmt-return 42))
-                (generate (stmt-goto 'foo)))
-              "
-break;
-continue;
-return ;
-return 42;
-goto foo;
-")
-
-
-(check-emited (generate (asm "move.l d0,d1"))
-              "asm(\"move.l d0,d1\");
-")
-
-(check-emited (generate (extern1 "C" (asm "move.l d0,d1")))
-              "extern \"C\"
-asm(\"move.l d0,d1\");
-")
-
-(check-emited (generate (extern "C" (list (asm "move.l d0,d1")
-                                          (asm "move.l d2,d0"))))
-              "extern \"C\"{
-    asm(\"move.l d0,d1\");
-    asm(\"move.l d2,d0\");
-}
-")
-
-(check-emited (generate (with-extern "C"
-                          (asm "move.l d0,d1")
-                          (asm "move.l d2,d0")))
-              "extern \"C\"{
-    asm(\"move.l d0,d1\");
-    asm(\"move.l d2,d0\");
-}
-")
-
-
-(check-emited (generate (pointer 'foo :const t :volatile t))
-              "* const volatile foo")
-
-;; C++
-(check-emited (generate (reference 'foo))
-              "&foo")
-
-;; C++
-(check-emited (generate (member-pointer 'bar 'foo :const t :volatile t))
-              "bar* const volatile foo")
-
-(check-emited (generate (c-function 'foo (list 'int)
-                                    :const t :volatile t :throw-list '(error warning)))
-              "foo(int) const volatile throw(CommonLisp_error,CommonLisp_warning) ")
-
-(check-emited (generate (c-vector 'com.informatimago.languages.linc.c::char 42))
-              "char[42]")
-
diff --git a/languages/linc/test-expressions.sexpc b/languages/linc/test-expressions.sexpc
new file mode 100644
index 0000000..9e01e24
--- /dev/null
+++ b/languages/linc/test-expressions.sexpc
@@ -0,0 +1,151 @@
+;; -*- mode:list; package:com.informatimago.languages.linc.c -*-
+
+(include <math.h>)
+
+(define-function test-priorities () void
+    (let* ((i int 42)
+           (j int 33)
+           (k int 21)
+           (a unsigned 101)
+           (b unsigned 202)
+           (c unsigned 303)
+           (d unsigned 404)
+           (e unsigned 505))
+
+      (= i (*= j 4))
+      (*= (*= i j) 4)
+
+      (+= i (*= j (? (== k 0) 1 0)))
+      (+= (*= i j) (? (== k 0) 1 0))
+
+      (*= i (\|\| (&& a b) (&& a c)))
+      (*= i (&& (\|\| a b) (\|\| a c)))
+
+      (+= i (\| (& a b) (& (~ a) c)))
+      (+= i (& (\| a b) (~ (\| a c))))
+      (+= i (~ (\| (& a b) (& (~ a) c))))
+      (+= i (& (~ (\| a (~ b))) (~ (\| a c))))
+
+      (+= j (\| a (^ b (& c (~ d)))))
+      (+= j (~ (& a (^ b (\| c d)))))
+
+      (+= k (+ (<< a (+ i j))
+               (<< b (+ j k))
+               (>> c (+ k i))))))
+
+;; Unary:
+(define-function main () (int)
+    (block
+
+        (define-variable cptr      (pointer char)            "foo bar")
+      (define-variable cptrptr   (pointer (pointer char))  (& cptr))
+      (define-variable char1     char                      (* cptr))
+
+      (define-variable pos       int                       (+ 1))
+      (define-variable neg       int                       (- 1))
+
+      ;; Binary:
+      (define-variable sum2      int                       (+ 1 2))
+      (define-variable sum4      int                       (+ 1 2 3 4))
+      (define-variable dif2      int                       (- 1 2))
+      (define-variable dif4      int                       (- 1 2 3 4))
+      (define-variable mul2      int                       (* 2 3))
+      (define-variable mul4      int                       (* 2 3 4 5))
+      (define-variable div2      int                       (/ 2 3))
+      (define-variable div4      int                       (/ 2 3 4 5))
+      (define-variable mod2      int                       (% 2 3))
+      (define-variable mod4      int                       (% 2 3 4 5))
+      (define-variable boolior   bool                      (\|\| (== pos 1) (== neg 1)))
+      (define-variable booland   bool                      (&& (== pos 1) (== neg 1)))
+      (define-variable bit-ior   int                       (\| sum2 mul2))
+      (define-variable bit-and   int                       (& sum2 mul2))
+      (define-variable bit-eor   int                       (^ sum2 mul2))
+      (define-variable beq       bool                      (== sum2 mul2))
+      (define-variable bne       bool                      (!= sum2 mul2))
+      (define-variable blt       bool                      (<  sum2 mul2))
+      (define-variable bgt       bool                      (>  sum2 mul2))
+      (define-variable ble       bool                      (<= sum2 mul2))
+      (define-variable bge       bool                      (>= sum2 mul2))
+      (define-variable lshift    int                       (<< sum2 pos))
+      (define-variable rshift    int                       (>> sum2 pos))
+      ;; memptr deref     .*
+      ;; ptrmemptr-deref ->*
+      (define-variable ucast     (unsigned int)              (cast mul4 unsigned int))
+      (define-variable size1     (unsigned int)              (sizeof char))
+      (define-variable size2     (unsigned int)              (sizeof cptr))
+
+      ;; Unary:
+      (define-variable mul4-p1   int                       (++ mul4))
+      (define-variable mul4-m1   int                       (-- mul4))
+      (define-variable mul4-p1p  int                       (post++ mul4))
+      (define-variable mul4-m1p  int                       (post-- mul4))
+      (define-variable boolnot   bool                      (! (== pos 1)))
+      (define-variable bit-not   int                       (~ mul4))
+
+
+      ;; Ternary
+      (define-variable if3       int                       (? (== mul2 6) 1 0))
+
+      ;; Miscellaneous:
+
+      (declare-structure point (x int) (y int))
+      ;; (define-variable pt1 point {1 2})
+      (declare-variable pt1 (struct point))
+      (= (. pt1 x) 1)
+      (= (. pt1 y) 2)
+      (define-variable pt1-x int (. pt1 x))
+      (define-variable ppt (pointer (struct point)) (& pt1))
+      (define-variable ppt1-y int (-> ppt y))
+      (define-variable cho    char (aref cptr 1))
+
+      (define-variable sin-pi-2 double (sin (/ M-PI 2)))
+
+      (define-variable seq  int (\, (++ size1) (++ size2) 3))
+
+      (cast cptr void)
+      (cast cptrptr void)
+      (cast char1 void)
+      (cast pos void)
+      (cast neg void)
+      (cast sum2 void)
+      (cast sum4 void)
+      (cast dif2 void)
+      (cast dif4 void)
+      (cast mul2 void)
+      (cast mul4 void)
+      (cast div2 void)
+      (cast div4 void)
+      (cast mod2 void)
+      (cast mod4 void)
+      (cast boolior void)
+      (cast booland void)
+      (cast bit-ior void)
+      (cast bit-and void)
+      (cast bit-eor void)
+      (cast beq void)
+      (cast bne void)
+      (cast blt void)
+      (cast bgt void)
+      (cast ble void)
+      (cast bge void)
+      (cast lshift void)
+      (cast rshift void)
+      (cast ucast void)
+      (cast size1 void)
+      (cast size2 void)
+      (cast mul4-p1 void)
+      (cast mul4-m1 void)
+      (cast mul4-p1p void)
+      (cast mul4-m1p void)
+      (cast boolnot void)
+      (cast bit-not void)
+      (cast if3 void)
+      (cast pt1 void)
+      (cast pt1-x void)
+      (cast ppt void)
+      (cast ppt1-y void)
+      (cast cho void)
+      (cast sin-pi-2 void)
+      (cast seq void)
+
+      (return 0)))
diff --git a/languages/linc/test-ii.lisp b/languages/linc/test-ii.lisp
index d11a907..22a399f 100644
--- a/languages/linc/test-ii.lisp
+++ b/languages/linc/test-ii.lisp
@@ -1,3 +1,6 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")

 (defclass a ()
   ())
diff --git a/languages/linc/test-include.sexpc b/languages/linc/test-include.sexpc
new file mode 100644
index 0000000..86e581d
--- /dev/null
+++ b/languages/linc/test-include.sexpc
@@ -0,0 +1,11 @@
+
+(include "foo.h")
+(include <foo.h>)
+(include "foo.h" "bar.h" <baz.h>)
+
+(include)
+(include "foo\".h")
+(include <foo>bar.h>)
+(include "good1.h" "foo\".h" "good2.h")
+(include <good1.h> <foo>bar.h> <good2.h>)
+
diff --git a/languages/linc/test-statements.sexpc b/languages/linc/test-statements.sexpc
new file mode 100644
index 0000000..e29b16d
--- /dev/null
+++ b/languages/linc/test-statements.sexpc
@@ -0,0 +1,50 @@
+;; -*- mode:list; package:com.informatimago.languages.linc.c -*-
+
+(include <stdio.h> <stdlib.h>)
+
+(define-function main ((argc int) (argv (pointer (pointer char)))) int
+
+    (let ((i int 0))
+
+      (while (< i 10)
+        (goto start1)
+        (+= i 2)
+        (label start1)
+        (++ i)
+        (printf "i = %d\n" i)
+        (if (< 5 i)
+            (break)
+            (continue))
+        (printf "Never printed!\n"))
+
+      (= i 0)
+      (do
+        (goto start2)
+        (+= i 2)
+        (label start2)
+        (++ i)
+        (printf "i = %d\n" i)
+        (if (< 5 i)
+            (break)
+            (continue))
+        (printf "Never printed!\n")
+        while (< i 10))
+
+      (= i 0)
+      (for ((= i 0) (< i 10) (++ i))
+        (switch i
+          (case 0
+            (printf "Zero\n")
+            (break))
+          (case (+ 1 1)
+            (printf "Two\n")
+            (break))
+          (default
+           (printf "Current %d\n" i)
+           (break)))
+        (if (== 0 (% i 3))
+            (+= i 2)
+            (+= i 3)))
+
+      (return 0)))
+
diff --git a/languages/linc/test-types.sexpc b/languages/linc/test-types.sexpc
new file mode 100644
index 0000000..9f11331
--- /dev/null
+++ b/languages/linc/test-types.sexpc
@@ -0,0 +1,174 @@
+;; -*- mode:lisp -*-
+(include <stdbool.h> <stdint.h>)
+
+(declare-type foo-c-t  char)
+(declare-type foo-ui-t const unsigned int)
+(declare-type foo-n-t  foo-c-t)
+
+(declare-type type-101-t char)
+(declare-type type-102-t signed char)
+(declare-type type-103-t unsigned char)
+(declare-type type-104-t short)
+(declare-type type-105-t signed short)
+(declare-type type-106-t short int)
+(declare-type type-107-t signed short int)
+(declare-type type-108-t unsigned short)
+(declare-type type-109-t unsigned short int)
+(declare-type type-110-t int)
+(declare-type type-111-t signed)
+(declare-type type-112-t signed int)
+(declare-type type-113-t unsigned)
+(declare-type type-114-t unsigned int)
+(declare-type type-115-t long)
+(declare-type type-116-t signed long)
+(declare-type type-117-t long int)
+(declare-type type-118-t signed long int)
+(declare-type type-119-t unsigned long)
+(declare-type type-120-t unsigned long int)
+(declare-type type-121-t long long)
+(declare-type type-122-t signed long long)
+(declare-type type-123-t long long int)
+(declare-type type-124-t signed long long int)
+(declare-type type-125-t unsigned long long)
+(declare-type type-126-t unsigned long long int)
+(declare-type type-127-t float)
+(declare-type type-128-t double)
+(declare-type type-129-t long double)
+(declare-type type-130-t bool)
+(declare-type type-131-t float complex)
+(declare-type type-132-t double complex)
+(declare-type type-133-t long double complex)
+
+
+(declare-type type-201-t char)
+(declare-type type-202-t char signed)
+(declare-type type-203-t char unsigned)
+(declare-type type-204-t short)
+(declare-type type-205-t short signed)
+(declare-type type-206-t int short)
+(declare-type type-207-t int short signed)
+(declare-type type-208-t short unsigned)
+(declare-type type-209-t int short unsigned)
+(declare-type type-210-t int)
+(declare-type type-211-t signed)
+(declare-type type-212-t int signed)
+(declare-type type-213-t unsigned)
+(declare-type type-214-t int unsigned)
+(declare-type type-215-t long)
+(declare-type type-216-t long signed)
+(declare-type type-217-t int long)
+(declare-type type-218-t int long signed)
+(declare-type type-219-t long unsigned)
+(declare-type type-220-t int long unsigned)
+(declare-type type-221-t long long)
+(declare-type type-222-t long long signed)
+(declare-type type-223-t int long long)
+(declare-type type-224-t int long long signed)
+(declare-type type-225-t long long unsigned)
+(declare-type type-226-t int long long unsigned)
+(declare-type type-227-t float)
+(declare-type type-228-t double)
+(declare-type type-229-t double long)
+(declare-type type-230-t bool)
+(declare-type type-231-t complex float)
+(declare-type type-232-t complex double)
+(declare-type type-233-t complex double long)
+
+
+
+(declare-structure point
+                   (x int)
+                   (y int))
+
+(declare-union object
+                (c char)
+                (s short)
+                (i int)
+                (l long)
+                (f float)
+                (d double))
+
+(declare-type point-t (struct
+                       (x int)
+                       (y int)))
+
+(declare-type object-t (union
+                        (c char)
+                        (s short)
+                        (i int)
+                        (l long)
+                        (f float)
+                        (d double)))
+
+(declare-type qobject-t (struct
+                        (c const volatile atomic char)
+                        (s const volatile short)
+                        (i const atomic int)
+                        (l const volatile atomic long)
+                        (f  volatile atomic float)
+                        (d1 const double)
+                        (d2 const atomic double)
+                        (d3 volatile atomic double)
+                        (d4 const double)
+                        (d5 atomic double)
+                        (d6 double)
+                        (d7 const double)))
+
+(declare-type pflags-t (struct pflags
+                               (n int (bit 1))
+                               (c int (bit 1))
+                               (z int (bit 1))
+                               (mode int (bit 3))
+                               (supervisor int (bit 1))))
+
+(declare-enumeration color
+                     color-black
+                     color-red
+                     (color-green 2)
+                     (color-blue  4))
+
+(declare-type color-t
+              (enum (black 0)
+                    red
+                    (green 2)
+                    (blue  4)))
+
+(declare-type colored-point-t (struct
+                               (x double)
+                               (y double)
+                               (color color-t)))
+
+
+(declare-type atomic-int-t (atomic int))
+(declare-type atomic-unsigned-short-int-t (atomic unsigned short int))
+;; (declare-type atomic-volatile-unsigned-short-int-t (atomic volatile unsigned short int))
+(declare-type atomic-foo-c-t (atomic foo-c-t))
+
+(declare-type pointer-int-t                                     (pointer int))
+(declare-type pointer-unsigned-short-int-t                      (pointer unsigned short int))
+;; (declare-type pointer-const-volatile-const-unsigned-short-int-t (pointer const volatile const unsigned short int))
+;; (declare-type pointer-const-const-volatile-unsigned-short-int-t (pointer const const volatile unsigned short int))
+(declare-type pointer-foo-c-t                                   (pointer foo-c-t))
+(declare-type pointer-colored-point-t                           (pointer colored-point-t))
+
+(define-constant bufsize  (unsigned int) 1000)
+
+(declare-type array-int-t              (array int))
+(declare-type array-int-star-t         (array int *))
+(declare-type array-int-42-t           (array int 42))
+(declare-type array-uint-42-t          (array (unsigned int) static  (= a 42)))
+(declare-type array-uint-4bufsize-t    (array (unsigned int) static  (= a (* bufsize 4))))
+
+(declare-type function-int-int-t           (function (int)  int))
+(declare-type function-int-void-noreturn-t (function (int)  void))
+(declare-type function-int-int-inline-t    (function (int)  int))
+(declare-type function-int-x-int-int-t     (function ((x int)        (y int))         int))
+(declare-type function-uint-x-uint-int-t   (function ((unsigned int) (unsigned int))  int))
+
+(declare-type flist-t (struct
+                       (count unsigned)
+                       (funs  (array ((function ((pointer object-t) (pointer char) (unsigned int)) int))))))
+
+(declare-function cons ((car (pointer object-t)) (cdr (pointer object-t))) (pointer object-t))
+(declare-function car ((cons (pointer object-t))) (pointer object-t))
+(declare-function cdr ((cons (pointer object-t))) (pointer object-t))
diff --git a/languages/linc/test.c b/languages/linc/test.c
deleted file mode 100644
index e69de29..0000000
diff --git a/languages/linc/test.lisp b/languages/linc/test.lisp
index 1266779..3d421e3 100644
--- a/languages/linc/test.lisp
+++ b/languages/linc/test.lisp
@@ -33,10 +33,8 @@
 ;;;;**************************************************************************
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf *readtable* (copy-readtable nil)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
 (setf *c-out* (open "test.c" :direction :output
                     :if-exists :supersede
                     :if-does-not-exist :create))
diff --git a/languages/linc/test.sexph b/languages/linc/test.sexph
new file mode 100644
index 0000000..a63de19
--- /dev/null
+++ b/languages/linc/test.sexph
@@ -0,0 +1,73 @@
+;;;; -*- mode:lisp -*-
+
+(.ifndef test-sexph
+
+  (include <stdint.h>)
+  (include <stdbool.h>)
+
+  (declare-function checked-malloc ((size size-t)) -> (pointer void))
+
+  (declare-structure point
+    (x float)
+    (y float)
+    (color uint32-t (bit 3)))
+
+  (declare-enumeration object-type
+    t-cons
+    t-fixnum
+    t-character
+    t-string
+    t-symbol)
+
+  (declare-structure cons
+    (car (struct object))
+    (cdr (struct object)))
+
+  (declare-union values
+    (kons cons)
+    (fixv sint64-t)
+    (flov double)
+    (stri string)
+    (symb symbol))
+
+  (declare-type object
+    (struct
+     (tag   object-type)
+     (value values)))
+
+  (declare-constant max-objects uint32-t)
+  (declare-variable next-object uint32-t)
+  (declare-function cons ((car (pointer object))
+                          (cdr (pointer object)))         -> cons)
+  (declare-function car ((kons (pointer object const)))   -> (pointer object))
+  (declare-function cdr ((kons (pointer object const)))   -> (pointer object))
+  (declare-function consp ((kons (pointer object const))) -> bool)
+
+  )
+
+
+(define-constant max-objects uint32-t 1024)
+(define-variable next-object uint32-t 0)
+
+(define-function cons ((car (pointer object))
+                       (cdr (pointer object))) -> cons
+  (let ((kons (checked-malloc (sizeof (* kons)))))
+    (when (== kons NULL)
+      (return NULL))
+    (= (-> kons tag) t-cons)
+    (= (. (-> kons value) kons car) car)
+    (= (. (-> kons value) kons cdr) cdr)
+    (return kons)))
+
+(define-function car ((kons (pointer object const))) -> (pointer object)
+  (check-type kons t-cons)
+  (return (. (-> kons value) kons car)))
+
+(define-function cdr ((kons (pointer object const))) -> (pointer object)
+  (check-type kons t-cons)
+  (return (. (-> kons value) kons cdr)))
+
+(define-function consp ((object (pointer object const))) -> bool
+  (check-type kons t-cons)
+  (return (. (-> kons value) kons cdr)))
+
diff --git a/languages/linc/utilities.lisp b/languages/linc/utilities.lisp
new file mode 100644
index 0000000..d441195
--- /dev/null
+++ b/languages/linc/utilities.lisp
@@ -0,0 +1,10 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LINC")
+
+(defun find-in-tree (item tree)
+  (cond
+    ((null tree) nil)
+    ((atom tree) (eql item tree))
+    (t (or (find-in-tree item (car tree))
+           (find-in-tree item (cdr tree))))))
ViewGit