Added asd file, implemented #include/#import.

Pascal J. Bourguignon [2015-06-28 09:33]
Added asd file, implemented #include/#import.
Filename
languages/cpp/built-in-macros.lisp
languages/cpp/c-string-reader.lisp
languages/cpp/com.informatimago.languages.cpp.asd
languages/cpp/cpp-macro.lisp
languages/cpp/cpp.lisp
languages/cpp/packages.lisp
languages/cpp/tests/Makefile
languages/cpp/tests/define.h
languages/cpp/tests/include-macro.h
languages/cpp/tests/priority.h
languages/cpp/token.lisp
diff --git a/languages/cpp/built-in-macros.lisp b/languages/cpp/built-in-macros.lisp
new file mode 100644
index 0000000..ea5506d
--- /dev/null
+++ b/languages/cpp/built-in-macros.lisp
@@ -0,0 +1,111 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               built-in-macros.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines the builtin cpp macros.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-06-27 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    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/>.
+;;;;**************************************************************************
+(in-package "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP")
+
+
+(defun string-literal (string)
+  (make-string-literal (format nil "~S" string)
+                       (context-column *context*) (context-line *context*) (context-file *context*)))
+(defun number-literal (value)
+  (make-number-literal (format nil "~A" value)
+                       (context-column *context*) (context-line *context*) (context-file *context*)))
+
+
+(defmacro define-built-in-macro (name kind &body lambda-list-and-body)
+  (let ((lambda-list (if (eql :function kind)
+                         (first lambda-list-and-body)
+                         nil))
+        (body        (if (eql :function kind)
+                         (rest lambda-list-and-body)
+                         nil)))
+    `(setf (environment-macro-definition *default-environment* ',name)
+           (make-instance
+            ',(ecase kind
+               (:object   'macro-definition/object/computed)
+               (:function 'macro-definition/function/computed))
+            :name ',name
+            :compute-expansion-function ,(if (eq kind :object)
+                                             `(lambda (macro-definition)
+                                               (declare (ignorable macro-definition))
+                                               ,@body)
+                                             `(lambda (macro-definition arguments)
+                                               (declare (ignorable macro-definition arguments))
+                                               ,@body))))))
+
+(define-built-in-macro "__TIMESTAMP__" :object
+  (when (option *context* :warn-date-time)
+    (cpp-warning *context* "macro ~A might prevent reproducible builds"  "__TIMESTAMP__"))
+  (let ((date (or (file-write-date (context-file *context*)) (get-universal-time))))
+    (multiple-value-bind (se mi ho da mo ye dow) (decode-universal-time date 0)
+      (string-literal (format nil "~[Mon~;Tue~;Wed~;Thi~;Fri~;Sat~;Sun~] ~[~;Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~2,'0D ~2,'0D:~2,'0D:~2,'0D ~4,'0D"
+                                   dow mo da ho mi se ye)))))
+
+(define-built-in-macro "__FILE__" :object
+  (string-literal (file-namestring (context-file *context*))))
+
+(define-built-in-macro "__BASE_FILE__" :object
+  (string-literal (file-namestring (context-base-file *context*))))
+
+(define-built-in-macro "__INCLUDE_LEVEL__" :object
+  (number-literal (format nil "~D" (context-include-level *context*))))
+
+(define-built-in-macro "__STDC__" :object
+  (number-literal 0 #|are we?|#))
+
+(define-built-in-macro "__DATE__" :object
+  (when (option *context* :warn-date-time)
+    (cpp-warning *context* "macro ~A might prevent reproducible builds"  "__DATE__"))
+  (let ((date (get-universal-time)))
+    (multiple-value-bind (se mi ho da mo ye dow) (decode-universal-time date 0)
+      (string-literal (format nil "~[~;Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~2,'0D ~4,'0D"
+                                   mo da ye)))))
+
+(define-built-in-macro "__TIME__" :object
+  (when (option *context* :warn-date-time)
+    (cpp-warning *context* "macro ~A might prevent reproducible builds"  "__DATE__"))
+  (let ((date (get-universal-time)))
+    (multiple-value-bind (se mi ho da mo ye dow) (decode-universal-time date 0)
+      (string-literal (format nil "~2,'0D:~2,'0D:~2,'0D" ho mi se)))))
+
+(define-built-in-macro "__COUNTER__" :object
+  (when (option *context* :directives-only)
+    (cpp-error *context* "__COUNTER__ expanded inside directive with -fdirectives-only"))
+  (let ((date (get-universal-time)))
+    (multiple-value-bind (se mi ho da mo ye dow) (decode-universal-time date 0)
+      (number-literal (prog1 (context-counter *context*)
+                        (incf (context-counter *context*)))))))
+
+
+
+;;;; THE END ;;;;
diff --git a/languages/cpp/c-string-reader.lisp b/languages/cpp/c-string-reader.lisp
new file mode 100644
index 0000000..4da33dd
--- /dev/null
+++ b/languages/cpp/c-string-reader.lisp
@@ -0,0 +1,216 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               c-string-reader.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    A C string reader, implememting 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 - 2015
+;;;;
+;;;;    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/>.
+;;;;**************************************************************************
+(in-package "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP")
+
+
+(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)
+  "Reads the emacs syntax for character
+ ?a -> 64
+ ?\\10 -> 8
+ ?\\x10 -> 16
+#\\? must have been already read.
+"
+  (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
+                           (cpp-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)))))))))
+
+;; (set-macro-character #\? 'character-code-reader-macro t)
+
+(defun read-c-string (stream delimiter)
+  "Read a C string or a C char from the STREAM, depending on delimiter = #\\\" or #\\'.
+The initial delimited must have been read already."
+  ;; TODO: "\xE9" and "é" won't issue the same bytes depending on the target encoding "\xE9" is fixed char[]{233,0}.
+  (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 (cond
+                              ((char= delimiter ch) :out)
+                              ((char= #\\       ch) :escape)
+                              (t                    (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
+                     (cpp-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))
+                       (cpp-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 #\" 'read-c-string nil rt)
+          (set-macro-character #\' 'read-c-string nil rt)
+          rt)))
+   (assert (equal  (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\" 'a' '\\xe9' '\\\\' '\\'' '\\n')")
+                  '("Hello, bell=, backspace=, page=, newline=
+, return=
, tab=	, vt=, \"double-quotes\", 'single-quotes', question?, backslash=\\, hexa=λ, octal=A, ?GÇ1"
+                    "a" "é" "\\" "'" "
+")))
+   :success))
+
+
+;;;; THE END ;;;;
diff --git a/languages/cpp/com.informatimago.languages.cpp.asd b/languages/cpp/com.informatimago.languages.cpp.asd
new file mode 100644
index 0000000..857fcfd
--- /dev/null
+++ b/languages/cpp/com.informatimago.languages.cpp.asd
@@ -0,0 +1,64 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.languages.cpp.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    ASD file to load the com.informatimago.languages.cpp library.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-06-28 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    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/
+;;;;**************************************************************************
+
+(asdf:defsystem "com.informatimago.languages.cpp"
+  ;; system attributes:
+  :description "An implementation of the C Pre Processor with some GNU cpp extensions."
+  :author     "Pascal J. Bourguignon <pjb@informatimago.com>"
+  :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
+  :licence "AGPL3"
+  ;; component  attributes:
+  :version "0.0.0"
+  :properties ((#:author-email                   . "pjb@informatimago.com")
+               (#:date                           . "Summer 2015")
+               ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.languages.cpp/")
+               ((#:albert #:formats)             . ("docbook"))
+               ((#:albert #:docbook #:template)  . "book")
+               ((#:albert #:docbook #:bgcolor)   . "white")
+               ((#:albert #:docbook #:textcolor) . "black"))
+  #+asdf-unicode :encoding #+asdf-unicode :utf-8
+  :depends-on ("com.informatimago.common-lisp.cesarum"
+               "babel")
+  :components ((:file "packages"        :depends-on  ())
+               (:file "c-string-reader" :depends-on  ("packages"))
+               (:file "cpp-macro"       :depends-on  ("packages"))
+               (:file "token"           :depends-on  ("packages" "cpp-macro"))
+               (:file "built-in-macros" :depends-on  ("packages" "cpp-macro" "token"))
+               (:file "cpp"             :depends-on  ("packages"
+                                                      "cpp-macro" "token"
+                                                      "built-in-macros"
+                                                      "c-string-reader")))
+  :in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.languages.cpp.test"))))
+
+;;;; THE END ;;;;
diff --git a/languages/cpp/cpp-macro.lisp b/languages/cpp/cpp-macro.lisp
new file mode 100644
index 0000000..91e6a54
--- /dev/null
+++ b/languages/cpp/cpp-macro.lisp
@@ -0,0 +1,190 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               cpp-macro.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines the cpp macros.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-06-28 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    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/>.
+;;;;**************************************************************************
+(in-package "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP")
+
+
+(defgeneric environment-macro-definedp (environment macro-name))
+(defgeneric environment-macro-undefine (environment macro-name))
+(defgeneric environment-macro-definition (environment macro-name))
+(defgeneric (setf environment-macro-definition) (definition environment macro-name))
+
+
+(defmethod environment-macro-definedp ((environment hash-table) (macro-name string))
+  (assert (eq 'equal (hash-table-test environment)))
+  (nth-value 1 (gethash macro-name environment)))
+
+(defmethod environment-macro-undefine ((environment hash-table) (macro-name string))
+  (assert (eq 'equal (hash-table-test environment)))
+  (remhash macro-name environment))
+
+(defmethod environment-macro-definition ((environment hash-table) (macro-name string))
+  (assert (eq 'equal (hash-table-test environment)))
+  (gethash macro-name environment))
+
+(defmethod (setf environment-macro-definition) (definition (environment hash-table) (macro-name string))
+  (assert (eq 'equal (hash-table-test environment)))
+  (setf (gethash macro-name environment) definition))
+
+
+
+(defclass macro-definition ()
+  ((name :initarg :name :accessor macro-definition-name)))
+
+(defgeneric expand-macro-definition (macro-definition &optional arguments))
+
+
+(defclass macro-definition/object (macro-definition)
+  ((expansion :initarg :expansion :accessor macro-definition-expansion)))
+
+(defmethod expand-macro-definition ((macro-definition macro-definition/object) &optional (arguments '() argumentsp))
+  (when argumentsp
+    (error "~S cannot take arguments for object-like macro ~A" 'expand-macro-definition  (macro-definition-name macro-definition)))
+  (macro-definition-expansion macro-definition))
+
+
+(defclass macro-definition/function (macro-definition)
+  ((parameters :initarg :parameters :initform '() :accessor macro-definition-parameters)
+   (expansion :initarg :expansion :accessor macro-definition-expansion)))
+
+(defmethod expand-macro-definition ((macro-definition macro-definition/function) &optional (arguments '() argumentsp))
+  (unless argumentsp
+    (error "~S needs arguments for function-like macro ~A()" 'expand-macro-definition (macro-definition-name macro-definition)))
+  (expand-macro-call macro-definition arguments))
+
+
+(defclass macro-definition/computed-mixin ()
+  ((compute-expansion-function :initarg :compute-expansion-function
+                               :accessor macro-definition-compute-expansion-function)))
+
+(defclass macro-definition/object/computed (macro-definition/object macro-definition/computed-mixin)
+  ())
+
+(defmethod expand-macro-definition ((macro-definition macro-definition/object/computed) &optional (arguments '() argumentsp))
+  (when argumentsp
+    (error "~S cannot take arguments for object-like macro ~A" 'expand-macro-definition (macro-definition-name macro-definition)))
+  (funcall (macro-definition-compute-expansion-function macro-definition) macro-definition))
+
+
+(defclass macro-definition/function/computed (macro-definition/function macro-definition/computed-mixin)
+  ())
+
+(defmethod expand-macro-definition ((macro-definition macro-definition/object/computed) &optional (arguments '() argumentsp))
+  (unless argumentsp
+    (error "~S needs arguments for function-like macro ~A()" 'expand-macro-definition (macro-definition-name macro-definition)))
+  (funcall (macro-definition-compute-expansion-function macro-definition) macro-definition arguments))
+
+
+
+
+(deftype option-key ()
+  `(member :warn-date-time
+           :directives-only
+           :substitute-trigraphs
+           :warn-on-trigraph
+           :warn-spaces-in-continued-lines
+           :single-line-comments
+           :accept-unicode-escapes
+           :dollar-is-punctuation
+
+           :include-disable-current-directory
+           ;; When true, files are not searched in the current directory.
+           ;; NOTE: current directory is defined as:
+           ;;        (or *load-truename* *compile-file-truename*
+           ;;            *default-pathname-defaults*)
+
+           :include-quote-directories
+           ;; Directories where #include \"\" files are searched.
+
+           :include-bracket-directories
+           ;; Directories where #include <> files are searched.
+           ;; May contain keywords indexing search functions in the following a-list:
+
+           :include-search-functions
+           ;; An a-list mapping keywords to search functions (lambda (path kind directive) …)
+           ;; kind (member :quote :bracket), directive (member :include :import)
+           ;; RETURN: NIL if include-file is not found,
+           ;;         T   if include-file is already included, or
+           ;;         a pathname to the include-file to be loaded.
+
+           ))
+
+(defparameter *default-options*
+  '((:warn-date-time . t)
+    (:directives-only . nil)
+    (:substitute-trigraphs . t)
+    (:warn-on-trigraph . t)
+    (:warn-spaces-in-continued-lines . t)
+    (:single-line-comments . t)
+    (:accept-unicode-escapes . t)
+    (:dollar-is-punctuation . nil)
+    (:include-disable-current-directory . nil)
+    (:include-quote-directories . ())
+    (:include-bracket-directories . ())
+    (:include-search-functions . ())
+    (:external-format . :default)))
+
+(defvar *default-environment* (make-hash-table :test 'equal))
+
+(defclass context ()
+  ((base-file      :initarg :base-file     :initform "-"                                     :accessor context-base-file)
+   (file           :initarg :file          :initform "-"                                     :accessor context-file)
+   (line           :initarg :line          :initform 1                                       :accessor context-line)
+   (column         :initarg :column        :initform 1                                       :accessor context-column)
+   (token          :initarg :token         :initform nil                                     :accessor context-token)
+   (counter        :initarg :counter       :initform 0                                       :accessor context-counter)
+   (include-level  :initarg :include-level :initform 0                                       :accessor context-include-level)
+   (if-level       :initarg :if-level      :initform 0                                       :accessor context-if-level)
+   (options        :initarg :options       :initform (copy-tree *default-options*)           :accessor context-options)
+   (environment    :initarg :environment   :initform (copy-hash-table *default-environment*) :accessor context-environment)))
+
+
+(defvar *context* nil)
+
+(defun updated-context (&key
+                          (token         nil tokenp)
+                          (line          nil linep)
+                          (column        nil columnp)
+                          (file          nil filep)
+                          (include-level nil include-level-p))
+  (when tokenp          (setf (context-token         *context*) token))
+  (when linep           (setf (context-line          *context*) line))
+  (when columnp         (setf (context-column        *context*) column))
+  (when filep           (setf (context-file          *context*) file))
+  (when include-level-p (setf (context-include-level *context*) include-level))
+  *context*)
+
+(defun option (context option)
+  (cdr (assoc option (context-options context))))
+
+;;;; THE END ;;;;
diff --git a/languages/cpp/cpp.lisp b/languages/cpp/cpp.lisp
index 2a14803..0ffec14 100644
--- a/languages/cpp/cpp.lisp
+++ b/languages/cpp/cpp.lisp
@@ -31,44 +31,12 @@
 ;;;;    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/>.
 ;;;;**************************************************************************
-
-(defpackage "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP"
-  (:use "COMMON-LISP"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
-  (:shadow "IMPORT" "INCLUDE")
-  (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
-                          "STRING-DESIGNATOR")
-  (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
-                          "COPY-STREAM")
-  (:export "TOKEN" "TOKEN-LINE" "TOKEN-COLUMN" "TOKEN-FILE"
-           "TOKEN-TEXT" "IDENTIFIER-TOKEN" "NUMBER-TOKEN" "PUNCTUATION-TOKEN"
-           "OTHER-TOKEN"
-
-           "READ-CPP-TOKENS"
-           "ENVIRONMENT-MACRO-DEFINITION"
-   "ENVIRONMENT-MACRO-DEFINEDP"
-   "ENVIRONMENT-MACRO-UNDEFINE"
-           "PROCESS"))
-
 (in-package "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP")


-(defun number-lines (lines file-name &key (start 1))
-  (loop
-    :for lino :from start
-    :for line :in lines
-    :collect (list line lino file-name)))
-
-(defstruct (numbered-line
-            (:type list)
-            (:conc-name line-))
-  (text "")
-  (lino 1)
-  (file "-"))


+;;; --------------------

 (declaim (inline trigraph-character))
 (defun trigraph-character (char)
@@ -99,8 +67,7 @@
                  (char= #\? (aref text (1+ i)))
                  (setf tri (trigraph-character (aref text (+ 2 i)))))
           :do (when warn-on-trigraph
-                (warn "~A:~A: found trigraph ??~A converted to ~A"
-                      (line-file line) (line-lino line) (aref text (+ 2 i)) tri))
+                (cpp-warning line "found trigraph ??~A converted to ~A" (aref text (+ 2 i)) tri))
               (setf (aref text j) tri)
               (incf j)
               (incf i 3)
@@ -112,6 +79,8 @@
   line)


+;;; --------------------
+
 (defun continued-line-p (line)
   (let ((len (length line)))
     (when (plusp len)
@@ -135,13 +104,12 @@
                                (loop :with result = '()
                                      :while continuedp
                                      :do (when (and spacesp warn-spaces-in-continued-lines)
-                                           (warn "~A:~A: spaces after line continuation character." file lino))
+                                           (cpp-warning (pseudo-token file lino) "spaces after line continuation character"))
                                          (push (subseq (line-text line) 0 continuedp) result)
                                          (setf line (pop lines))
                                          (if (null line)
                                              (progn
-                                               (warn "~A:~A: last line is a continued line"
-                                                     file lino)
+                                               (cpp-warning (pseudo-token file lino) "last line is a continued line")
                                                (setf continuedp nil))
                                              (multiple-value-setq (continuedp spacesp) (continued-line-p (line-text line))))
                                      :finally (push (line-text line) result)
@@ -151,6 +119,7 @@
                      line)))))


+;;; --------------------

 (defun remove-comments-in-line (comment-start-line current-line state single-line-comments)
   (destructuring-bind (text lino file) current-line
@@ -211,7 +180,7 @@
                     (incf i)
                     (if (< i (length text))
                         (incf i)
-                        (progn (cerror "Continue" "~A:~A: backslash in string literal at the end of the line" file lino)
+                        (progn (cpp-error (pseudo-token file lino) "backslash in string literal at the end of the line")
                                (setf state :top))))
                    ((#\")
                     (incf i)
@@ -223,7 +192,7 @@
                     (incf i)
                     (if (< i (length text))
                         (incf i)
-                        (progn (cerror "Continue" "~A:~A: backslash in character literal at the end of the line" file lino)
+                        (progn (cpp-error (pseudo-token file lino) "backslash in character literal at the end of the line")
                                (setf state :top))))
                    ((#\')
                     (incf i)
@@ -231,10 +200,10 @@
                    (otherwise (incf i))))))
         :finally (return (case state
                            (:in-string
-                            (cerror "Continue" "~A:~A: unterminated string literal at the end of the line" file lino)
+                            (cpp-error (pseudo-token file lino) "unterminated string literal at the end of the line")
                             (values (concatenate-chunks (nreverse chunks)) :top))
                            (:in-character
-                            (cerror "Continue" "~A:~A: unterminated character literal at the end of the line" file lino)
+                            (cpp-error (pseudo-token file lino) "unterminated character literal at the end of the line")
                             (values (concatenate-chunks (nreverse chunks)) :top))
                            (:top
                             (values (concatenate-chunks (nreverse (if (< start (length text))
@@ -259,38 +228,12 @@
                    :do (multiple-value-setq (new-line new-state)
                          (remove-comments-in-line new-line (pop lines) new-state single-line-comments)))
                  (when (eql new-state :in-multiline-comment)
-                   (cerror "Continue" "~A:~A: end of file before end of multiline comment" file lino)
+                   (cpp-error (pseudo-token file lino) "end of file before end of multiline comment")
                    (setf new-state :top))
                  (setf state new-state)
                  new-line))))

-
-
-(defclass token ()
-  ((line   :initform 0   :initarg :line   :accessor token-line)
-   (column :initform 0   :initarg :column :accessor token-column)
-   (file   :initform "-" :initarg :file   :accessor token-file)
-   (text                 :initarg :text   :accessor token-text)))
-
-(defmacro define-token-class (name)
-  (let ((class-name (intern (concatenate 'string (string name) (string '-token)))))
-    `(progn
-       (defclass ,class-name   (token) ())
-       (defmethod print-object ((self ,class-name) stream)
-         (print-unreadable-object (self stream :identity nil :type t)
-           (format stream "~A:~A:~A: ~S"
-                   (token-file self) (token-line self) (token-column self) (token-text self)))
-         self)
-       (defun ,(intern (concatenate 'string (string 'make-) (string name))) (text column line file)
-         (make-instance ',class-name :text text :column column :line line :file file)))))
-
-(define-token-class identifier)
-(define-token-class number)
-(define-token-class string-literal)
-(define-token-class character-literal)
-(define-token-class punctuation)
-(define-token-class other)
-
+;;; --------------------

 (defparameter *whitespaces* #(#\space #\tab #\vt #\page #\nul #\newline #\return #\linefeed))

@@ -301,6 +244,13 @@
     :do (incf start))
   start)

+(defun skip-spaces-but-one (text start)
+  (let ((start (skip-spaces text start)))
+    (when (and (plusp start)
+               (find (aref text (1- start)) *whitespaces*))
+      (decf start))
+    start))
+
 (defun small-unicode-escape-p (text start)
   (and (<= (+ start 6) (length text))
        (char= #\\ (aref text start))
@@ -389,9 +339,8 @@ RETURN: the token text; the end position."
             ((char= #\\ ch)
              (if (< (1+ end) (length text))
                  (incf end 2)
-                 (cerror "Continue" "~A:~A: unterminated ~:[string~;character~] literal ending with incomplete escape"
-                       (line-file line) (line-lino line)
-                       (char= terminator #\'))))
+                 (cpp-error line "unterminated ~:[string~;character~] literal ending with incomplete escape"
+                            (char= terminator #\'))))
             (t
              (incf end))))
     :finally (return (values (subseq text start end) end))))
@@ -432,8 +381,7 @@ RETURN: the token text; the end position."
         ((#\>)                  (greedy3 "=>"   ">>="))
         ((#\%)                  (greedy3 "=>:"  "%:%:"))
         (otherwise
-         (cerror "Continue" "~A:~A: invalid punctuation: ~S"
-                 (line-file line) (line-lino line) ch)
+         (cpp-error line "invalid punctuation: ~S" ch)
          (values "?" (1+ start)))))))


@@ -444,65 +392,82 @@ RETURN: the token text; the end position."
 (defun tokenize-line (line &key (accept-unicode-escapes nil)
                              (dollar-is-punctuation nil))
   (destructuring-bind (text lino file) line
-    (let ((start 0)
-          (first-identifier (if dollar-is-punctuation
-                                "_"
-                                "_$")))
-      (loop
-        :with header = 1
-        :do (setf start (skip-spaces text start))
-        :while (< start (length text))
-        :collect (let ((ch (aref text start)))
-                   (cond
-                     ((or (find ch first-identifier)
-                          (alpha-char-p ch)
-                          (and accept-unicode-escapes
-                               (char= #\\ ch)
-                               (< (1+ start) (length text))
-                               (char-equal #\u (aref text (1+ start)))))
-                      (multiple-value-bind (token end) (scan-identifier line start first-identifier
-                                                                        :accept-unicode-escapes accept-unicode-escapes)
-                        (if (and (eql 2 header) (or (string= "include" token)
-                                                    (string= "import" token)))
-                            (setf header t)
-                            (setf header nil))
-                        (prog1 (make-identifier token start lino file)
-                          (setf start end))))
-                     ((or (and (char= ch #\.)
-                               (< (1+ start) (length text))
-                               (digit-char-p (aref text (1+ start))))
-                          (digit-char-p ch))
-                      (multiple-value-bind (token end) (scan-number line start)
-                        (setf header nil)
-                        (prog1 (make-number token start lino file)
-                          (setf start end))))
-                     ((char= #\" ch)
-                      (multiple-value-bind (token end) (scan-delimited-literal line start)
-                        (setf header nil)
-                        (prog1 (make-string-literal token start lino file)
-                          (setf start end))))
-                     ((char= #\' ch)
-                      (multiple-value-bind (token end) (scan-delimited-literal line start)
-                        (setf header nil)
-                        (prog1 (make-character-literal token start lino file)
-                          (setf start end))))
-                     ((and (eq header t) (char= #\< ch))
-                      (multiple-value-bind (token end) (scan-delimited-literal line start)
-                        (setf header nil)
-                        (prog1 (make-string-literal token start lino file)
-                          (setf start end))))
-                     ((punctuatorp ch)
-                      (multiple-value-bind (token end) (scan-punctuation line start)
-                        (if (and (eql 1 header) (string= "#" token))
-                            (setf header 2)
-                            (setf header nil))
-                        (prog1 (make-punctuation token start lino file)
-                          (setf start end))))
-                     (t ;; others
+    (loop
+      :with first-identifier   := (if dollar-is-punctuation
+                                      "_"
+                                      "_$")
+      :with start              := 0
+      :with header             := 1 ; we track #import and #include to allow <header.h> delimited literals.
+      :with record-space-token := nil ; we track #define to detect the same in NAME ( vs. NAME(
+      :do (setf start (ecase record-space-token
+                        ((nil)
+                         (skip-spaces text start))
+                        ((:before-name)
+                         (setf record-space-token :after-name)
+                         (skip-spaces text start))
+                        (:after-name
+                         (setf record-space-token nil)
+                         (skip-spaces-but-one text start))))
+      :while (< start (length text))
+      :collect (let ((ch (aref text start)))
+                 (cond
+                   ((or (find ch first-identifier)
+                        (alpha-char-p ch)
+                        (and accept-unicode-escapes
+                             (char= #\\ ch)
+                             (< (1+ start) (length text))
+                             (char-equal #\u (aref text (1+ start)))))
+                    (multiple-value-bind (token end) (scan-identifier line start first-identifier
+                                                                      :accept-unicode-escapes accept-unicode-escapes)
+                      (when (eql 2 header)
+                        (when (and (null record-space-token)
+                                   (string= "define" token))
+                          (setf record-space-token :before-name))
+                        (setf header (if (or (string= "include" token)
+                                             (string= "import" token))
+                                         3
+                                         nil)))
+                      (prog1 (make-identifier token start lino file)
+                        (setf start end))))
+                   ((char= ch #\space)
+                    (prog1 (make-punctuation " " start lino file)
+                      (incf start)))
+                   ((or (and (char= ch #\.)
+                             (< (1+ start) (length text))
+                             (digit-char-p (aref text (1+ start))))
+                        (digit-char-p ch))
+                    (multiple-value-bind (token end) (scan-number line start)
                       (setf header nil)
-                      (prog1 (make-other (subseq text start (1+ start)) start lino file)
-                        (incf start)))))))))
-
+                      (prog1 (make-number token start lino file)
+                        (setf start end))))
+                   ((char= #\" ch)
+                    (multiple-value-bind (token end) (scan-delimited-literal line start)
+                      (setf header nil)
+                      (prog1 (make-string-literal token start lino file)
+                        (setf start end))))
+                   ((char= #\' ch)
+                    (multiple-value-bind (token end) (scan-delimited-literal line start)
+                      (setf header nil)
+                      (prog1 (make-character-literal token start lino file)
+                        (setf start end))))
+                   ((and (eql 3 header) (char= #\< ch))
+                    (multiple-value-bind (token end) (scan-delimited-literal line start)
+                      (setf header nil)
+                      (prog1 (make-string-literal token start lino file)
+                        (setf start end))))
+                   ((punctuatorp ch)
+                    (multiple-value-bind (token end) (scan-punctuation line start)
+                      (if (and (eql 1 header) (string= "#" token))
+                          (setf header 2)
+                          (setf header nil))
+                      (prog1 (make-punctuation token start lino file)
+                        (setf start end))))
+                   (t ;; others
+                    (setf header nil)
+                    (prog1 (make-other (subseq text start (1+ start)) start lino file)
+                      (incf start))))))))
+
+;;; --------------------


 ;; The preprocessor is greedy: a+++++b --> a ++ ++ + b
@@ -564,57 +529,23 @@ RETURN: the token text; the end position."
                              :single-line-comments single-line-comments))))


-(defun sharpp (token)
-  (and (typep token 'punctuation-token)
-       (or (string= "#"  (token-text token)))))
-
-(defun sharpsharpp (token)
-  (and (typep token 'punctuation-token)
-       (or (string= "##"  (token-text token)))))
-
-(defun openp (token)
-  (and (typep token 'punctuation-token)
-       (or (string= "("  (token-text token)))))
-
-(defun closep (token)
-  (and (typep token 'punctuation-token)
-       (or (string= ")"  (token-text token)))))
-
-(defun commap (token)
-  (and (typep token 'punctuation-token)
-       (or (string= ","  (token-text token)))))
-
-(defun ellipsisp (token)
-  (and (typep token 'punctuation-token)
-       (or (string= "..."  (token-text token)))))
-
-
-(defun identifierp (token)
-  (typep token 'identifier-token))
-
-
-(defgeneric environment-macro-definedp (environment macro-name))
-(defgeneric environment-macro-undefine (environment macro-name))
-(defgeneric environment-macro-definition (environment macro-name))
-(defgeneric (setf environment-macro-definition) (definition environment macro-name))
-
-(defmethod environment-macro-definedp ((environment hash-table) (macro-name string))
-  (assert (eq 'equal (hash-table-test environment)))
-  (nth-value 1 (gethash macro-name environment)))
-
-(defmethod environment-macro-undefine ((environment hash-table) (macro-name string))
-  (assert (eq 'equal (hash-table-test environment)))
-  (remhash macro-name environment))
-
-(defmethod environment-macro-definition ((environment hash-table) (macro-name string))
-  (assert (eq 'equal (hash-table-test environment)))
-  (gethash macro-name environment))
-
-(defmethod (setf environment-macro-definition) (definition (environment hash-table) (macro-name string))
-  (assert (eq 'equal (hash-table-test environment)))
-  (setf (gethash macro-name environment) definition))
+;;;; --------------------
+;;;; Processing directives
+;;;; --------------------

+(defmacro with-cpp-line (line &body body)
+  (let ((vtoken (gensym)))
+    `(let* ((,vtoken (first ,line))
+            (file (token-file ,vtoken))
+            (lino (token-line ,vtoken))
+            (*context* (updated-context :file file :line lino :column (token-column ,vtoken) :token ,vtoken)))
+      (pop ,line) (pop ,line)
+      (locally
+          ,@body))))

+;;; --------------------
+;;; #define
+;;; --------------------

 (defun parse-stringifies (line parameters)
   (loop
@@ -629,7 +560,7 @@ RETURN: the token text; the end position."
                                         :key (function token-text)
                                         :test (function string=))))
                        (progn
-                         (cerror "Continue" "~A:~A: '#' is not followed by a macro parameter" file lino)
+                         (cpp-error (pseudo-token file lino) "'#' is not followed by a macro parameter")
                          (if (null parameter)
                              sharp
                              parameter))
@@ -640,8 +571,7 @@ RETURN: the token text; the end position."
 (defun parse-concatenates (line)
   (if (sharpsharpp (first line))
       (progn
-        (cerror "Continue" "~A:~A: '##' cannot appear at either end of a macro expansion"
-                (token-file (first line)) (token-line (first line)))
+        (cpp-error (first line) "'##' cannot appear at either end of a macro expansion")
         line)
       (loop
         :with result = ()
@@ -655,7 +585,7 @@ RETURN: the token text; the end position."
                             :while (sharpsharpp (first line))
                             :do (pop line)
                                 (unless line
-                                  (cerror "Continue" "~A:~A: '##' cannot appear at either end of a macro expansion" file lino))
+                                  (cpp-error (pseudo-token file lino) "'##' cannot appear at either end of a macro expansion"))
                                 (unless (sharpsharpp (first line))
                                   (push (pop line) concat))
                             :finally (return `(:concatenate ,@(nreverse concat)))) result))
@@ -670,11 +600,12 @@ RETURN: the token text; the end position."
   (when line
     (parse-concatenates line)))

-
-(defun parse-macro-definition (line)
+(defun parse-macro-definition (name line)
   (cond
     ((null line)
-     '())
+     (make-instance 'macro-definition/object
+                    :name name
+                    :expansion '()))
     ((openp (first line))
      (let ((file (token-file (first line)))
            (lino (token-line (first line))))
@@ -687,89 +618,262 @@ RETURN: the token text; the end position."
                                              (progn
                                                (pop line)
                                                (unless (and line (closep (first line)))
-                                                 (cerror "Continue" "~A:~A: ellipsis should be the last macro parameter"
-                                                        (token-file parameter) (token-line parameter)))
+                                                 (cpp-error parameter "ellipsis should be the last macro parameter"))
                                                (list ':ellipsis parameter))
                                              (progn
                                                (unless (and line (or (commap (first line)) (closep (first line))))
-                                                 (cerror "Continue" "~A:~A: Missing a comma after parameter ~A"
-                                                        (token-file parameter) (token-line parameter) (token-text parameter)))
+                                                 (cpp-error "Missing a comma after parameter ~A"  (token-text parameter)))
                                                parameter)))
                                         ((ellipsisp parameter)
                                          (unless (and line (closep (first line)))
-                                           (cerror "Continue" "~A:~A: ellipsis should be the last macro parameter"
-                                                  (token-file parameter) (token-line parameter)))
+                                           (cpp-error parameter "ellipsis should be the last macro parameter"))
                                          '(:ellipsis))
                                         (t
-                                         (cerror "Continue" "~A:~A: Expected a macro parameter name, not ~S"
-                                                 (token-file parameter) (token-line parameter) (token-text parameter))
+                                         (cpp-error parameter "Expected a macro parameter name, not ~S" (token-text parameter))
                                          parameter)))
                            :while (and line (commap (first line)))
                            :do (pop line)
                            :finally (if (and line (closep (first line)))
                                         (pop line)
-                                        (cerror "Continue" "~A:~A: Expected a closing parentheses after the parameter list" file lino)))))
-         (list :function parameters (parse-function-macro-definition-body line parameters)))))
+                                        (cpp-error (pseudo-token file lino) "Expected a closing parentheses after the parameter list")))))
+         (make-instance 'macro-definition/function
+                        :name name
+                        :parameters parameters
+                        :expansion (parse-function-macro-definition-body line parameters)))))
+    ((spacep (first line))
+     (pop line)
+     (make-instance 'macro-definition/object
+                    :name name
+                    :expansion (parse-object-macro-definition-body line)))
     (t
-     (list :object (parse-object-macro-definition-body line)))))
-
+     (make-instance 'macro-definition/object
+                    :name name
+                    :expansion (parse-object-macro-definition-body line)))))

 (defun define (line environment)
-  (let ((file (token-file (first line)))
-        (lino (token-file (first line))))
-    (pop line) (pop line)
+  (with-cpp-line line
     (if line
         (let ((name (pop line)))
           (if (identifierp name)
               (let ((old-definition (environment-macro-definition environment (token-text name)))
-                    (new-definition (parse-macro-definition line)))
+                    (new-definition (parse-macro-definition name line)))
                 (when (environment-macro-definedp environment (token-text name))
                   (unless (equal old-definition new-definition)
-                    (warn "~A:~A: Redefiniting the macro ~A with a different definition"
-                          (line-file name) (line-lino name) (token-text name))))
+                    (cpp-warning name "Redefiniting the macro ~A with a different definition" (token-text name))))
                 (setf (environment-macro-definition environment (token-text name)) new-definition))
-              (cerror "Continue" "~A:~A: Expected an identifier as macro name after #define, not ~S"
-                      (line-file line) (line-lino line) (token-text name))))
-        (cerror "Continue" "~A:~A: Missing macro name after #define" file lino))))
+              (cpp-error line "Expected an identifier as macro name after #define, not ~S" (token-text name))))
+        (cpp-error (pseudo-token file lino) "Missing macro name after #define"))))
+
+;;; --------------------
+;;; #undef
+;;; --------------------

 (defun undef (line environment)
-  (let ((file (token-file (first line)))
-        (lino (token-file (first line))))
-    (pop line) (pop line)
-    (if line
-        (progn
-          (let ((name (pop line)))
-            (if (identifierp name)
-                (environment-macro-undefine environment-macro-undefine (token-text name))
-                (cerror "Continue" "~A:~A: Expected an identifier as macro name after #undef, not ~S"
-                        (line-file name) (line-lino name) (token-text name))))
-          (when line
-            (cerror "Continue" "~A:~A: Didn't expect anything after the macro name after #undef, not ~S"
-                    (line-file (first line)) (line-lino (first line)) (token-text (first line)))))
-        (cerror "Continue" "~A:~A: Missing macro name after #undef" file lino))))
+  (with-cpp-line line
+   (if line
+       (progn
+         (let ((name (pop line)))
+           (if (identifierp name)
+               (environment-macro-undefine environment (token-text name))
+               (cpp-error name "Expected an identifier as macro name after #undef, not ~S" (token-text name))))
+         (when line
+           (cpp-error (first line) "Didn't expect anything after the macro name after #undef, not ~S" (token-text (first line)))))
+       (cpp-error (pseudo-token file lino) "Missing macro name after #undef"))))
+
+
+
+;;; --------------------
+;;; #include & #import
+;;; --------------------
+
+;; TODO: implement caching of already included files with #ifndef/#define and #import.
+
+;; #include <> searches files only in *include-bracket-directories*
+;;
+;; #include "" searches files
+;; in the current directory unless *include-disable-current-directory* is true,
+;; then in *include-quote-directories*
+;; and finally in *include-bracket-directories*.
+
+(defun search-file-in-directories (include-file directories kind directive)
+  (loop
+    :with include-search-functions := (option *context* :include-search-functions)
+    :for directory :in directories
+    :for path := (if (keywordp directory)
+                     (let ((search-function (cdr (assoc directory include-search-functions))))
+                       (if search-function
+                           (funcall search-function include-file kind directive)
+                           (progn
+                             (cpp-warning "No search function for key ~S" directory)
+                             nil)))
+                     (merge-pathnames include-file directory))
+    :when (and path (or (eq t path) (probe-file path)))
+      :do (return path)
+    :finally (return nil)))
+
+(defun include-directories (kind)
+  (let ((include-disable-current-directory (option *context* :include-disable-current-directory))
+        (include-quote-directories         (option *context* :include-quote-directories))
+        (include-bracket-directories       (option *context* :include-bracket-directories)))
+    (append (if (eq kind :quote)
+                (remove-duplicates
+                 (append (unless include-disable-current-directory
+                           (list (make-pathname :name nil :type nil :version nil)))
+                         include-quote-directories)
+                 :test (function equal))
+                '())
+            (remove-duplicates include-bracket-directories :test (function equal)))))
+
+(defun perform-include (include-file kind directive)
+  (flet ((include (path)
+           (let ((*context* (updated-context :file path :include-level (1+ (context-include-level *context*)))))
+             (read-and-process-file path))))
+    (let* ((include-directories (include-directories kind))
+           (path                (search-file-in-directories include-file include-directories kind directive)))
+      (cond ((eq t path) #|done|#)
+            (path        (include path))
+            (t           (cpp-error *context*
+                                    "Cannot find a file ~C~A~C in the include directories ~S"
+                                    (if (eq kind :quote) #\" #\<)
+                                    include-file
+                                    (if (eq kind :quote) #\" #\>)
+                                    include-directories))))))
+
+
+
+(defgeneric token-string (token)
+  (:method ((token token)) (token-text token))
+  (:method ((token string-literal-token))
+    (with-input-from-string (in (token-text token))
+      (read-c-string in (read-char in))))
+  (:method ((token character-literal-token))
+    (with-input-from-string (in (token-text token))
+      (read-c-string in (read-char in)))))
+
+;; (princ (token-string (make-instance 'string-literal-token :text "\"abc\\ndef\\t\\xe9t\\xe9\\a\"")))
+
+(defun extract-path (directive line)
+  (let ((token (first line)))
+    (cond
+      ((string-literal-p token)
+       (let ((text (token-text token)))
+         (cond ((zerop (length text))
+                (cpp-error token "Invalid empty path")
+                (values "" :quote (rest line)))
+               ((char= #\< (aref text 0))
+                (values (subseq text 1 (1- (length text))) :bracket (rest line)))
+               (t
+                (values (token-string token) :quote (rest line))))))
+      ((open-bracket-p token)
+       (pop line)
+       (values (mapconcat (function token-text) (loop
+                                                  :with item
+                                                  :while line
+                                                  :do (setf item (pop line))
+                                                  :until (close-bracket-p item)
+                                                  :collect item) "") :bracket line))
+      (t
+       (cpp-error (first line) "In directive ~A, invalid path ~S"
+                  directive (mapconcat (function token-text) line ""))
+       (values nil nil nil)))))
+


+(defun include-common (directive line include-level environment)
+  (with-cpp-line line
+    (if line
+        (let ((line (cpp-macro-expand line environment))) ; macro-functions must stand on a single line after #include/#import.
+          (multiple-value-bind (path kind line) (extract-path directive line)
+            (when path
+              (perform-include path kind directive))
+            (when line
+              (cpp-error (first line) "Didn't expect anything after the path after #~(~A~), not ~S"
+                         directive (token-text (first line))))))
+        (cpp-error (pseudo-token file lino) "Missing path after #~(~A~)" directive))))
+
 (defun include (line include-level environment)
-  )
+  (include-common :include line include-level environment))
+
 (defun import (line include-level environment)
-  )
+  (include-common :import line include-level environment))
+
+;;; --------------------
+;;; #ifdef
+;;; --------------------
+
+(defun parse-single-macro-name (line where)
+  (cond
+    ((null line)
+     (cpp-error *context* "Missing a macro name after ~A" where)
+     nil)
+    ((cddr line)
+     (cpp-error (first line) "Unexpected tokens after macro name ~A after ~A" (token-text (first line)) where)
+     nil)
+    ((identifierp (first line))
+     (first line))
+    (t
+     (cpp-error (first line) "Invalid macro name ~A after ~A" (token-text (first line)) where)
+     nil)))
+
+(defun ifdef-common (line lines if-level environment flip directive)
+  (let ((name (parse-single-macro-name line directive)))
+    (cond
+      ((null name)
+       (skip-ifdef-branch lines if-level)
+       (skip-else-branch lines if-level))
+      ((funcall flip (environment-macro-definedp environment (token-text name)))
+       (process-ifdef-branch lines if-level)
+       (skip-else-branch lines if-level))
+      (t
+       (skip-ifdef-branch lines if-level)))))
+
 (defun ifdef (line lines if-level environment)
-  )
+  (ifdef-common line lines if-level environment (function identity) "#ifdef"))
+
 (defun ifndef (line lines if-level environment)
-  )
+  (ifdef-common line lines if-level environment (function not) "#ifndef"))
+
 (defun cpp-if (line lines if-level environment)
   )
+
+;;; --------------------
+;;; #line
+;;; --------------------
+
 (defun cpp-line (line lines if-level environment)
-  )
+  (print line)
+  (print (first lines)))
+
+;;; --------------------
+;;; #pragma
+;;; --------------------
+
 (defun pragma (line environment)
   )
-(defun cpp-error (line environment)
+
+;;; --------------------
+;;; #error
+;;; --------------------
+
+(defun cpp-error-line (line environment)
   )
-(defun cpp-warning (line environment)
+
+;;; --------------------
+;;; #warning
+;;; --------------------
+
+(defun cpp-warning-line (line environment)
   )

-(defun cpp-macro-expand)
-(defun process (tokenized-lines environment &key (if-level 0) (include-level 0))
+;;; --------------------
+;;; pre-processing files
+;;; --------------------
+
+(defun cpp-macro-expand (line tokenized-lines output environment)
+  ;; TODO
+  (values tokenized-lines (cons line output)))
+
+(defun process-file (tokenized-lines environment &key (if-level 0) (include-level 0))
   "
 TOKENIZED-LINES: a list of list of tokens (one sublist per input line).
 ENVIRONMENT:     an object with the ENVIRONMENT-MACRO-DEFINITION accessor,
@@ -781,40 +885,90 @@ RETURN:          the C-pre-processed source in form of list of list of tokens
     :with output = '()
     :while tokenized-lines
     :do (let ((line (pop tokenized-lines)))
-          (if (and (sharpp (first line))
-                   (identifierp (second line)))
-              (scase (token-text (second line))
-                (("define")  (define line environment))
-                (("undef")   (undef  line environment))
-                (("include") (nreconc (include line include-level environment) output))
-                (("import")  (nreconc (import  line include-level environment) output))
-                (("ifdef")   (setf tokenized-lines (ifdef  line tokenized-lines if-level environment)))
-                (("ifndef")  (setf tokenized-lines (ifndef line tokenized-lines if-level environment)))
-                (("if")      (setf tokenized-lines (cpp-if line tokenized-lines if-level environment)))
-                (("elif" "else" "endif"))
-                (("line")    (setf tokenized-lines (cpp-line line tokenized-lines environment)))
-                (("pragma")  (pragma      line environment))
-                (("error")   (cpp-error   line environment))
-                (("warning") (cpp-warning line environment))
-                (("ident" "sccs"))
-                (otherwise (cerror "Continue" "~A:~A: invalid directive ~A"
-                                   (line-file line) (line-lino line) (token-text (second line)))))
-              ;; (multiple-value-setq (tokenized-lines output) (cpp-macro-expand line tokenized-lines output environment))
-              (push line output)))
+          (print line)
+          (if (sharpp (first line))
+              (cond
+                ((identifierp (second line))
+                 (scase (token-text (second line))
+                   (("define")  (define line environment))
+                   (("undef")   (undef  line environment))
+                   (("include") (nreconc (include line include-level environment) output))
+                   (("import")  (nreconc (import  line include-level environment) output))
+                   (("ifdef")   (setf tokenized-lines (ifdef  line tokenized-lines if-level environment)))
+                   (("ifndef")  (setf tokenized-lines (ifndef line tokenized-lines if-level environment)))
+                   (("if")      (setf tokenized-lines (cpp-if line tokenized-lines if-level environment)))
+                   (("elif" "else" "endif"))
+                   (("line")    (setf tokenized-lines (cpp-line line tokenized-lines environment)))
+                   (("pragma")  (pragma           line environment))
+                   (("error")   (cpp-error-line   line environment))
+                   (("warning") (cpp-warning-line line environment))
+                   (("ident" "sccs"))
+                   (otherwise (cpp-error line "invalid directive ~A" (token-text (second line))))))
+                ((number-token-p (second line)) ;; skip # 1 "file"
+                 (push line output))
+                ((rest line)
+                 (cpp-error line "invalid directive #~A" (token-text (second line))))
+                (t ;; skip # alone.
+                 ))
+              (multiple-value-setq (tokenized-lines output) (cpp-macro-expand line tokenized-lines output environment))))
     :finally (return (nreverse output))))

-
+(defun read-and-process-file (path)
+  (with-open-file (input path :external-format (option *context* :external-format))
+    (process-file (read-cpp-tokens
+                   input
+                   :file-name (namestring path)
+                   :substitute-trigraphs            (option *context* :substitute-trigraphs)
+                   :warn-on-trigraph                (option *context* :warn-on-trigraph)
+                   :warn-spaces-in-continued-lines  (option *context* :warn-spaces-in-continued-lines)
+                   :single-line-comments            (option *context* :single-line-comments)
+                   :accept-unicode-escapes          (option *context* :accept-unicode-escapes)
+                   :dollar-is-punctuation           (option *context* :dollar-is-punctuation))
+                  (context-environment *context*))))
+
+(defun process-toplevel-file (path &key (options *default-options*))
+  (let ((*context* (make-instance 'context :base-file path :file path :options options)))
+    (read-and-process-file path)))
+
+(defun write-processed-lines (lines &optional (*standard-output* *standard-output*))
+  (when lines
+    (loop
+      :with file := nil
+      :with lino := nil
+      :for line :in lines
+      :when line
+        :do (if (and (equal file (token-file (first line)))
+                     lino
+                     (= (1+ lino) (token-line (first line))))
+                (incf lino)
+                (format t "#line ~D ~S~%"
+                        (setf lino (token-line (first line)))
+                        (setf file (token-file (first line)))))
+            (format t "~{~A~^ ~}~%" (mapcar (function token-text) line)))))
+
+;;; --------------------

 #-(and) (progn

+          (write-processed-lines
+           (process-toplevel-file "tests/test.c"
+                                  :options (acons :include-quote-directories '("tests/")
+                                                  *default-options*)))
+
+          (write-processed-lines
+           (process-toplevel-file "tests/priority.h"
+                                  :options (acons :include-quote-directories '("tests/")
+                                                  *default-options*)))
+
+
           (let ((file "tests/define.h"))
             (with-open-file (in file)
               (let ((environment (make-hash-table :test 'equal)))
-                (process (read-cpp-tokens in
-                                          :file-name file
-                                          :substitute-trigraphs t
-                                          :warn-on-trigraph nil)
-                         environment)
+                (process-file (read-cpp-tokens in
+                                               :file-name file
+                                               :substitute-trigraphs t
+                                               :warn-on-trigraph nil)
+                              environment)
                 (print-hashtable environment))))


@@ -998,7 +1152,37 @@ RETURN:          the C-pre-processed source in form of list of list of tokens
                  '("..." 12)))
   :success)

+(defun text/skip-spaces ()
+  (assert (equal (skip-spaces "    xyz()" 0) 4))
+  (assert (equal (skip-spaces "    xyz()" 7) 7))
+  (assert (equal (skip-spaces "    xyz ()" 7) 8))
+  (assert (equal (skip-spaces-but-one "    xyz()" 0) 3))
+  (assert (equal (skip-spaces-but-one "    xyz()" 7) 7))
+  (assert (equal (skip-spaces-but-one "    xyz ()" 7) 7))
+  :success)
+
+(defun test/extract-path ()
+  (assert (equal (multiple-value-list (extract-path "#include"
+                                                    (list (make-instance 'string-literal-token
+                                                                         :text "\"/usr/local/include/\\xe9t\\xe9.h\""))))
+                 '("/usr/local/include/été.h" :quote nil)))
+  (assert (equal (multiple-value-list (extract-path "#include"
+                                                    (list (make-instance 'string-literal-token
+                                                                         :text "</usr/local/include/\\xe9t\\xe9.h>"))))
+                 '("/usr/local/include/\\xe9t\\xe9.h" :bracket nil)))
+  (assert (equal (multiple-value-list (extract-path "#include"
+                                                    (list (make-instance 'punctuation-token :text "<")
+                                                          (make-instance 'string-literal-token
+                                                                         :text "/usr/local/include")
+                                                          (make-instance 'string-literal-token
+                                                                         :text "/file.h")
+                                                          (make-instance 'punctuation-token :text ">"))))
+                 '("/usr/local/include/file.h" :bracket nil)))
+  :success)
+
+
 (defun test/all ()
+  (test/read-c-string)
   (test/number-lines)
   (test/substitute-trigraphs)
   (test/merge-continued-lines)
@@ -1006,8 +1190,12 @@ RETURN:          the C-pre-processed source in form of list of list of tokens
   (test/remove-comments)
   (test/scan-identifier)
   (test/scan-number)
-  (test/scan-punctuation))
+  (test/scan-punctuation)
+  (text/skip-spaces)
+  (test/extract-path))

 (test/all)

+
+
 ;;;; THE END ;;;;
diff --git a/languages/cpp/packages.lisp b/languages/cpp/packages.lisp
new file mode 100644
index 0000000..4e9ca2b
--- /dev/null
+++ b/languages/cpp/packages.lisp
@@ -0,0 +1,57 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               packages.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines the C Preprocessor packages.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-06-27 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    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/>.
+;;;;**************************************************************************
+
+(defpackage "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
+  (:shadow "IMPORT" "INCLUDE")
+  (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
+                          "STRING-DESIGNATOR")
+  (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
+                          "COPY-STREAM")
+  (:export "PROCESS-TOPLEVEL-FILE"
+           "TOKEN" "TOKEN-LINE" "TOKEN-COLUMN" "TOKEN-FILE"
+           "TOKEN-TEXT" "IDENTIFIER-TOKEN" "NUMBER-TOKEN" "PUNCTUATION-TOKEN"
+           "OTHER-TOKEN"
+           "ENVIRONMENT-MACRO-DEFINITION"
+           "ENVIRONMENT-MACRO-DEFINEDP"
+           "ENVIRONMENT-MACRO-UNDEFINE"
+           ;;;
+           "READ-CPP-TOKENS"
+           ))
+
+;;;; THE END ;;;;
+
diff --git a/languages/cpp/tests/Makefile b/languages/cpp/tests/Makefile
index 9e00d0d..10a869d 100644
--- a/languages/cpp/tests/Makefile
+++ b/languages/cpp/tests/Makefile
@@ -5,4 +5,6 @@ priority:
 	gcc -E -o - priority.h
 concat:
 	gcc -E -o - concat.h
+include-macro:
+	gcc -I.. -E -o - include-macro.h

diff --git a/languages/cpp/tests/define.h b/languages/cpp/tests/define.h
index 206bb3a..45e4822 100644
--- a/languages/cpp/tests/define.h
+++ b/languages/cpp/tests/define.h
@@ -1,5 +1,12 @@
 #define EMPTY
 #define VOO 42
+#define OOO (X)
 #define FOO(X) ((X)+42)
 #define SOO(X) #X
 #define COO(X,Y) X##Y
+#define TO_BE_UNDEFINED_1
+#define TO_BE_UNDEFINED_2 X
+#define TO_BE_UNDEFINED_3(X) ((X)+(X))
+#undef TO_BE_UNDEFINED_1
+#undef TO_BE_UNDEFINED_2
+#undef TO_BE_UNDEFINED_3
diff --git a/languages/cpp/tests/include-macro.h b/languages/cpp/tests/include-macro.h
new file mode 100644
index 0000000..e2e1ff4
--- /dev/null
+++ b/languages/cpp/tests/include-macro.h
@@ -0,0 +1,7 @@
+#define S(X) SS(X)
+#define SS(X) # X
+#define C(X,Y,Z) X##Y##Z
+#define F(X,Y) S(X##Y)
+#include F(tests/def,ine.h)
+#include F(tests/def,\
+           ine.h)
diff --git a/languages/cpp/tests/priority.h b/languages/cpp/tests/priority.h
index b97bb8a..6405dc8 100644
--- a/languages/cpp/tests/priority.h
+++ b/languages/cpp/tests/priority.h
@@ -5,4 +5,21 @@

 char* a=M(HELLO,KITTY);

+#
+
+# 1 "hello"
+
+

+#define f(a,b,c) {a,b,c}
+f(
+#define aa 1
+#define bb 2
+#define cc 3
+  aa,
+#if 0
+  )
+#endif
+  bb,
+#undef cc
+  cc)
diff --git a/languages/cpp/token.lisp b/languages/cpp/token.lisp
new file mode 100644
index 0000000..9589e1d
--- /dev/null
+++ b/languages/cpp/token.lisp
@@ -0,0 +1,167 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               token.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines cpp tokens.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-06-28 <PJB>
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    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/>.
+;;;;**************************************************************************
+(in-package "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP")
+
+
+(defclass token ()
+  ((line   :initform 0   :initarg :line   :accessor token-line)
+   (column :initform 0   :initarg :column :accessor token-column)
+   (file   :initform "-" :initarg :file   :accessor token-file)
+   (text                 :initarg :text   :accessor token-text)))
+
+
+
+(defstruct (numbered-line
+            (:type list)
+            (:conc-name line-))
+  (text "")
+  (lino 1)
+  (file "-"))
+
+(defun number-lines (lines file-name &key (start 1))
+  (loop
+    :for lino :from start
+    :for line :in lines
+    :collect (make-numbered-line :text line :lino lino :file file-name)))
+
+(defmethod token-file ((numbered-line cons))
+  (line-file numbered-line))
+(defmethod token-line ((numbered-line cons))
+  (line-lino numbered-line))
+(defmethod token-column ((numbered-line cons))
+  1)
+(defmethod token-text ((numbered-line cons))
+  (line-text numbered-line))
+
+
+
+(defmacro define-token-class (name)
+  (let ((class-name (intern (concatenate 'string (string name) (string '-token)))))
+    `(progn
+       (defclass ,class-name   (token) ())
+       (defun ,(intern (concatenate 'string (string name) (string '-p))) (object)
+         (typep object ',class-name))
+       (defmethod print-object ((self ,class-name) stream)
+         (print-unreadable-object (self stream :identity nil :type t)
+           (format stream "~A:~A:~A: ~S"
+                   (token-file self) (token-line self) (token-column self) (token-text self)))
+         self)
+       (defun ,(intern (concatenate 'string (string 'make-) (string name))) (text column line file)
+         (make-instance ',class-name :text text :column column :line line :file file)))))
+
+(define-token-class identifier)
+(define-token-class number)
+(define-token-class string-literal)
+(define-token-class character-literal)
+(define-token-class punctuation)
+(define-token-class other)
+
+(defun pseudo-token (file lino)
+  (make-other "" 0 lino file))
+
+
+(defun sharpp (token)
+  (and (typep token 'punctuation-token)
+       (or (string= "#"  (token-text token)))))
+
+(defun sharpsharpp (token)
+  (and (typep token 'punctuation-token)
+       (or (string= "##"  (token-text token)))))
+
+(defun spacep (token)
+  (and (typep token 'punctuation-token)
+       (or (string= " "  (token-text token)))))
+
+(defun openp (token)
+  (and (typep token 'punctuation-token)
+       (or (string= "("  (token-text token)))))
+
+(defun closep (token)
+  (and (typep token 'punctuation-token)
+       (or (string= ")"  (token-text token)))))
+
+(defun open-bracket-p (token)
+  (and (typep token 'punctuation-token)
+       (or (string= "<"  (token-text token)))))
+
+(defun close-bracket-p (token)
+  (and (typep token 'punctuation-token)
+       (or (string= ">"  (token-text token)))))
+
+(defun commap (token)
+  (and (typep token 'punctuation-token)
+       (or (string= ","  (token-text token)))))
+
+(defun ellipsisp (token)
+  (and (typep token 'punctuation-token)
+       (or (string= "..."  (token-text token)))))
+
+
+(defun identifierp (token)
+  (typep token 'identifier-token))
+
+(defun number-token-p (token)
+  (typep token 'number-token))
+
+
+
+(defun cpp-error (token format-control &rest format-arguments)
+  (let ((*context* (if (typep token 'context)
+                       token
+                       (updated-context :token token
+                                        :line (token-line token)
+                                        :column (token-column token)
+                                        :file (token-file token)))))
+    (cerror "Continue" "~A:~A: ~?"
+            (context-file *context*)
+            (context-line *context*)
+            format-control format-arguments)))
+
+(defun cpp-warning (token format-control &rest format-arguments)
+  (let ((*context* (if (typep token 'context)
+                       token
+                       (updated-context :token token
+                                        :line (token-line token)
+                                        :column (token-column token)
+                                        :file (token-file token)))))
+    (warn "~A:~A: ~?"
+          (context-file *context*)
+          (context-line *context*)
+          format-control format-arguments)))
+
+
+
+
+
+;;;; THE END ;;;;
ViewGit