Implemented #if expressions.

Pascal J. Bourguignon [2015-07-01 14:51]
Implemented #if expressions.
Filename
languages/cpp/com.informatimago.common-lisp.languages.cpp.asd
languages/cpp/cpp-macro.lisp
languages/cpp/cpp.lisp
languages/cpp/expression.lisp
languages/cpp/tests/Makefile
languages/cpp/tests/if.c
languages/cpp/tests/ifdef.c
languages/cpp/tests/recursive.c
languages/cpp/token.lisp
diff --git a/languages/cpp/com.informatimago.common-lisp.languages.cpp.asd b/languages/cpp/com.informatimago.common-lisp.languages.cpp.asd
index b721c53..8f51476 100644
--- a/languages/cpp/com.informatimago.common-lisp.languages.cpp.asd
+++ b/languages/cpp/com.informatimago.common-lisp.languages.cpp.asd
@@ -32,14 +32,14 @@
 ;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
 ;;;;**************************************************************************

-(asdf:defsystem "com.informatimago.languages.cpp"
+(asdf:defsystem "com.informatimago.common-lisp.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"
+  :version "0.0.2"
   :properties ((#:author-email                   . "pjb@informatimago.com")
                (#:date                           . "Summer 2015")
                ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.languages.cpp/")
@@ -56,11 +56,15 @@
                (:file "token"           :depends-on  ("packages" "cpp-macro"))
                (:file "built-in-macros" :depends-on  ("packages" "cpp-macro" "token"))
                (:file "pragma-gcc"      :depends-on  ("packages" "cpp-macro" "token"))
+               (:file "expression"      :depends-on  ("packages"
+                                                      "cpp-macro" "token"
+                                                      "c-string-reader"))
                (:file "cpp"             :depends-on  ("packages"
                                                       "cpp-macro" "token"
                                                       "built-in-macros"
                                                       "pragma-gcc"
-                                                      "c-string-reader")))
-  :in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.languages.cpp.test"))))
+                                                      "c-string-reader"
+                                                      "expression")))
+  :in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.common-lisp.languages.cpp.test"))))

 ;;;; THE END ;;;;
diff --git a/languages/cpp/cpp-macro.lisp b/languages/cpp/cpp-macro.lisp
index cb79fc2..f5a2ae2 100644
--- a/languages/cpp/cpp-macro.lisp
+++ b/languages/cpp/cpp-macro.lisp
@@ -33,6 +33,11 @@
 ;;;;**************************************************************************
 (in-package "COM.INFORMATIMAGO.COMMON-LISP.LANGUAGES.CPP")

+(defvar *context* nil) ; the current instance of context.
+
+
+;; Cpp macro definitions are kept in the environment hash-table, keyed
+;; by the macro name (string).

 (defgeneric environment-macro-definedp (environment macro-name))
 (defgeneric environment-macro-undefine (environment macro-name))
@@ -59,37 +64,27 @@
   (assert (eq 'equal (hash-table-test environment)))
   (setf (gethash macro-name environment) definition))

-
-;; Only one level of embedded lexical scope, for function-like macro parameters is possible.
-
-(defstruct lexical-environment
-  global
-  bindings)
-
-(defmethod environment-macro-definedp ((environment lexical-environment) (macro-name string))
-  (or (assoc macro-name (lexical-environment-bindings environment)
-             :test (function string=)
-             :key (function token-text))
-      (environment-macro-definedp (lexical-environment-global environment) macro-name)))
-
-(defmethod environment-macro-definition ((environment lexical-environment) (macro-name string))
-  (let ((entry (assoc macro-name (lexical-environment-bindings environment)
-                      :test (function string=)
-                      :key (function token-text))))
-    (if entry
-        (cdr entry)
-        (environment-macro-definition (lexical-environment-global environment) macro-name))))
-
-
+;; The values kept in the environment are instances of subclasses of macro-definition.

 (defclass macro-definition ()
   ((name :initarg :name :accessor macro-definition-name)))

-(defgeneric expand-macro-definition (macro-definition &optional arguments))
+(defgeneric expand-macro-definition (macro-definition &optional arguments)
+  (:documentation
+   "Binds the arguments (list of list of tokens) to the macro
+parameters if any, and expands the macro.
+
+object-like macros don't take arguments.

+function-like macros take an argument list, possibly empty, but if it
+contains a single empty list of tokens and the function-like macro
+takes no parameters, then it's still a match (at this stage, we don't
+distinguish f() from f( ) anymore.
+"))

 (defclass macro-definition/object (macro-definition)
-  ((expansion :initarg :expansion :accessor macro-definition-expansion)))
+  ((expansion :initarg :expansion :accessor macro-definition-expansion))
+  (:documentation "Normal object-like macro."))

 (defmethod print-object ((macro macro-definition/object) stream)
   (let ((*print-circle* nil))
@@ -107,7 +102,8 @@

 (defclass macro-definition/function (macro-definition)
   ((parameters :initarg :parameters :initform '() :accessor macro-definition-parameters)
-   (expansion :initarg :expansion :accessor macro-definition-expansion)))
+   (expansion :initarg :expansion :accessor macro-definition-expansion))
+  (:documentation "Normal function-like macro."))

 (defmethod print-object ((macro macro-definition/function) stream)
   (let ((*print-circle* nil))
@@ -122,8 +118,201 @@
   (and (consp parameter)
        (eq :ellipsis (first parameter))))

+;;; ------------------------------------------------------------
+;;; The expand-macro-definition method for normal macros.
+;;; ------------------------------------------------------------
+
+#|
+
+object-like macros
+------------------
+
+- The macro definition is a single line of token.
+
+- When the macro is expanded, the expansion is macroexpanded:
+
+       #undef FOO
+       #undef BAR
+       #define FOO BAR
+       int i[]={ FOO,
+       #undef BAR
+       #define BAR 1
+                 FOO,
+       #undef BAR
+       #define BAR 2
+                 FOO };
+    -->
+        int i[]={ BAR,
+
+
+                  1,
+
+
+                  2 };
+
+- But happily, an object-like macro cannot expand to a partial
+  function-like macro invocation:
+
+        #define LEFT F("l",
+        #define RIGHT ,"r")
+        #define FOO LEFT "foo" RIGHT
+        1: FOO; /* ok, FOO expands to F("l","foo","r") */
+        #define F(a,b,c) a##b##c
+        // 2: FOO; /* good: error: unterminated argument list invoking macro "F" (in expanding LEFT from FOO)*/
+
+- Recursive expansion is detected and prevented.
+
+Therefore we can process object-like macro expansions independently.
+
+
+
+function-like macros
+--------------------
+
+This is crazy.
+
+- macro arguments are macro-expanded before they are substituted in the macro body,
+  but not for their stringify and token concatenation use:
+
+        #define VOO 42
+        #define F(X) #X[X]
+
+        F(33)
+        F(VOO)
+        F(C(VOO,VOO))
+    -->
+        "33"[33]
+        "VOO"[42]
+        "C(VOO,VOO)"[VOOVOO]
+
+   So basically, we need to pass the arguments under two forms.
+
+
+   "If an argument is stringified or concatenated, the prescan does
+    not occur. If you want to expand a macro, then stringify or
+    concatenate its expansion, you can do that by causing one macro to
+    call another macro that does the stringification or
+    concatenation."
+  This doesn't sound right, from the above test.
+
+
+- after substitution the entire macro expansion is again scanned for
+  macros to be expanded.
+
+- The self-references that do not expand in the first scan are marked
+  so that they will not expand in the second scan either. !!!
+
+- but happily again, a function-like macro cannot expand to a partial
+  function-like macro invocation, so we can also perform this later
+  expansion independently.
+
+  But "toplevel" function-like macro calls can span several lines,
+  including pre-processor directives (#ifs, #defines, #includes, etc).
+  So parsing function-like macros calls must take into account several
+  lines, and may have to perform recursive directive processing
+
+
+        #undef LEFT
+        #undef RIGHT
+        #undef FOO
+        #undef F
+        #define FOO(E) F(l,E,r)
+        1: FOO(foo); /* ok */
+        #define F(a,b,c) a##b##c
+        2: FOO(bar); /* ok since FOO(E) contains the whole F() call. */
+        3: FOO(
+        #define F(a,b,c) a##a
+               baz
+        #undef F
+        #define F(a,b,c) c##c
+               );
+        4: FOO(
+        #undef F
+        #define F(a,b,c) a##a
+               FOO(baz)
+        #undef F
+        #define F(a,b,c) c##c
+               );
+    -->
+        1: F(l,foo,r);
+
+        2: lbarr;
+
+        3: rr
+
+
+
+
+                ;
+        4: rr


+
+
+
+                ;
+
+    Note: the result 4!  The arguments are macro expanded only when
+    the macro call F() is being computed, ie. after we've seen the
+    closing parenthesis.
+
+
+- macro arguments must be parenthesis-balanced (only (), not {} or []).
+  Within (), commas don't split arguments:
+
+        #define F(X) ((X)+(X))
+        F((1,2))
+    -->
+        ((1,2)+(1,2)) /* == 4 */
+
+- unshielded commas in macro arguments are used as argument separators:
+
+      #define foo a,b
+      #define bar(x) lose(x)
+      #define lose(x) (1+(x))
+      bar(foo) --> lose(a,b) /* wrong argument count */
+
+- arguments may be empty.
+
+      #define foo(a,b) {(0,a),(1,b)}
+    -->
+      foo(,) --> {(0,),(1,)}
+
+
+- cf. variadic parameters.
+
+ambiguity, with:
+    #define f() foo
+    #define g(x) bar
+then
+    f() g()
+have different argument counts :-)
+
+concatenation
+-------------
+
+    However, two tokens that don't together form a valid token cannot
+    be pasted together. For example, you cannot concatenate x with +
+    in either order. If you try, the preprocessor issues a warning and
+    emits the two tokens.
+
+    Also, ## concatenates only the first or last token of the argument:
+        #define CONCAT(A,B) A ## B
+        CONCAT(a b,c d)
+    -->
+        a bc d /* 3 tokens */
+
+    If the argument is empty, that ‘##’ has no effect.
+
+|#
+
+
+;; While macroexpanding function-like macros, we need to bind
+;; arguments to parameters.  Arguments are reified in this argument
+;; structure, keeping both the tokens of the arguments, and their
+;; macro-expanded form, and with lazy initialization of the
+;; stringified version.
+
 (defstruct argument
   tokens
   expanded
@@ -234,13 +423,21 @@
                (return :error))
              (return bindings)))

+(defmacro skip-nil (block-name macro-name-token-var line-var tokenized-lines-var)
+  `(loop :while (null ,line-var)
+         :do (if (null ,tokenized-lines-var)
+                 (progn
+                   (cpp-error *context* "Reached end of file in function-like macro call ~A"
+                              (token-text ,macro-name-token-var))
+                   (return-from ,block-name nil))
+                 (setf ,line-var (pop ,tokenized-lines-var)))))
+
 (defun macro-bindings-expand-arguments (bindings)
   (flet ((marg (tokens)
            (make-argument
             :tokens tokens
-            :expanded (reduce (function nconc) (macro-expand-macros tokens '() '()
-                                                                    (context-macros-being-expanded *context*)
-                                                                    (context-environment *context*))))))
+            :expanded (reduce (function nconc) (macro-expand-macros *context* tokens '() '() nil
+                                                                    (context-macros-being-expanded *context*))))))
     (dolist (binding bindings bindings)
       (if (and (listp (cdr binding))
                (eq :ellipsis (second binding)))
@@ -312,13 +509,17 @@
     ;; substitute parameters in definition.
     (remove nil (substitute-concatenates (substitute-parameters definition bindings)))))

+;;; ------------------------------------------------------------
+;;; built-ins, computed macros.
+;;; ------------------------------------------------------------

 (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)
-  ())
+  ()
+  (:documentation "Built-in, computed object-like macro."))

 (defmethod print-object ((macro macro-definition/object/computed) stream)
   (let ((*print-circle* nil))
@@ -333,9 +534,9 @@
     (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)
-  ())
+  ()
+  (:documentation "Built-in, computed function-like macro."))

 (defmethod print-object ((macro macro-definition/function/computed) stream)
   (let ((*print-circle* nil))
@@ -350,18 +551,37 @@
     (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))

-
-
+;;; ------------------------------------------------------------
+;;; context
+;;; ------------------------------------------------------------

 (deftype option-key ()
   `(member :warn-date-time
+           ;; Warns when using built-in __DATE__ __TIME__ and __TIMESTAMP__
+           ;; as them may produce artificially different executables.
+
            :directives-only
+
            :substitute-trigraphs
-           :warn-on-trigraph
-           :warn-spaces-in-continued-lines
+           ;; allow trigraph substitutions.
+
+           :warn-on-trigraph
+           ;; when trigraphs are substituted, warn about it.
+
+           :warn-spaces-in-continued-lines
+
            :single-line-comments
-           :accept-unicode-escapes
+           ;; allow // comments.
+
+           :accept-unicode-escapes
+           ;;
+
            :dollar-is-punctuation
+           ;; when true, $ is considered punctuation.
+           ;; when NIL, $ is considered a letter for identifiers.
+
+           :warn-on-undefined-identifier
+           ;; in #if expressions warns about undefined identifiers

            :include-disable-current-directory
            ;; When true, files are not searched in the current directory.
@@ -394,6 +614,7 @@
     (:single-line-comments . t)
     (:accept-unicode-escapes . t)
     (:dollar-is-punctuation . nil)
+    (:warn-on-undefined-identifier . nil)
     (:include-disable-current-directory . nil)
     (:include-quote-directories . ())
     (:include-bracket-directories . ())
@@ -456,6 +677,9 @@
                           :initform (make-hash-table :test 'equal)
                           :accessor context-pragmas
                           :documentation "An equal hash-table for pragmas defined by the program. Keys may be symbols or lists of symbols.")))
+
+(defun option (context option)
+  (cdr (assoc option (context-options context))))

 (defmethod context-include-level ((context context))
   (length (context-file-stack context)))
@@ -489,23 +713,146 @@
           (context-current-line context) (pop data)))
   context)

-
-(defvar *context* nil)
-
 (defmethod update-context ((context context) &key
                           (token         nil tokenp)
                           (line          nil linep)
                           (column        nil columnp)
-                          (file          nil filep)
-                          (include-level nil include-level-p))
+                          (file          nil filep))
   (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))))
+;;; ------------------------------------------------------------
+;;; macro-expand-macros, expands macro on one or more tokenized lines.
+;;; ------------------------------------------------------------
+
+(defmacro expect (macro-name-token-var token-predicate-name line-var tokenized-lines-var)
+  `(block expect
+     (skip-nil expect ,macro-name-token-var ,line-var ,tokenized-lines-var)
+     (if (,token-predicate-name (first ,line-var))
+         (return-from expect (pop ,line-var))
+         (progn
+           (cpp-error (first ,line-var) "Expected a ~A in function-like macro call ~A, not ~A"
+                      (token-predicate-label ',token-predicate-name)
+                      (token-text ,macro-name-token-var)
+                      (token-text (first ,line-var)))
+           (return-from expect nil)))))
+
+(defun parse-function-macro-call-arguments (macro-name-token line tokenized-lines)
+  ;; function-macro-call     ::= macro-name '(' arglist  ')' .
+  ;; arglist                 ::= argument | argument ',' arglist .
+  ;; argument                ::= | argument-item argument .
+  ;; argument-item           ::= non-parenthesis-or-comma-token | parenthesized-item-list .
+  ;; parenthesized-item-list ::= '(' item-list ')' .
+  ;; item-list               ::= | non-parenthesis-or-comma-token | ',' | parenthesized-item-list .
+  (labels ((skip-nil-not-eof-p ()
+             (block skip
+               (skip-nil skip macro-name-token line tokenized-lines)
+               t))
+           (arglist ()
+             (loop
+               :collect (parse-argument)
+               :while (and (skip-nil-not-eof-p)
+                           (commap (first line)))
+               :do (pop line)))
+           (parenthesized-item-list ()
+             (let ((left  (expect macro-name-token openp line tokenized-lines))
+                   (items (item-list))
+                   (right (or (expect macro-name-token closep line tokenized-lines)
+                              (list (make-punctuation ")" 1 1 "-")))))
+               (nconc (list left) items (list right))))
+           (item-list ()
+             (loop
+               :while (and (skip-nil-not-eof-p)
+                           (not (closep (first line))))
+               :if (openp (first line))
+                 :append (parenthesized-item-list)
+               :else
+                 :collect (pop line)))
+           (parse-argument-item ()
+             (cond
+               ((openp (first line))
+                (parenthesized-item-list))
+               ((commap (first line))
+                '())
+               (t
+                (list (pop line)))))
+           (parse-argument ()
+             (when (skip-nil-not-eof-p)
+               (if (commap (first line))
+                   '()
+                   (loop
+                     :while (and (skip-nil-not-eof-p)
+                                 (not (commap (first line)))
+                                 (not (closep (first line))))
+                     :nconc (parse-argument-item))))))
+    (if (expect macro-name-token openp line tokenized-lines)
+        (values (let ((arglist (arglist)))
+                  (unless (expect macro-name-token closep line tokenized-lines)
+                    (setf line nil))
+                  arglist)
+                line
+                tokenized-lines)
+        (values '() line tokenized-lines))))
+
+(defmethod macro-expand-macros ((context context) line tokenized-lines output-lines allow-defined already-expanded)
+  (loop
+    :with environment = (context-environment context)
+    :with out-line := '()
+    :while line
+    :do (flet ((definedp (identifier)
+                 (make-number (if (environment-macro-definedp (context-environment context) (token-text identifier))
+                                  "1" "0"))))
+          (let* ((token (pop line))
+                 (name  (and token (token-text token))))
+            (if (identifierp token)
+                (cond ((and allow-defined (string= "defined" name))
+                       (let ((next (first line)))
+                         (cond ((openp next)
+                                (pop line)
+                                (let ((name (pop line)))
+                                  (if (identifierp name)
+                                      (progn
+                                        (if (closep (first line))
+                                            (pop line)
+                                            (cpp-error name "Missing a closing parenthesis after defined(~A" (token-text name)))
+                                        (push (definedp name) out-line))
+                                      (progn
+                                        (cpp-error (or next context) "operator \"defined\" requires an identifier")
+                                        (push (make-number "0") out-line)))))
+                               ((identifierp next)
+                                (pop line)
+                                (push (definedp next) out-line))
+                               (t
+                                (cpp-error (or next context) "operator \"defined\" requires an identifier")
+                                (push (make-number "0") out-line)))))
+                      ((environment-macro-definedp environment name)
+                       (let ((definition (environment-macro-definition environment name)))
+                         (etypecase definition
+                           (macro-definition/object
+                            (if (member name already-expanded :test (function string=))
+                                (push token out-line)
+                                (setf out-line (nreconc (first (macro-expand-macros context (expand-macro-definition definition)
+                                                                                    '() '() allow-defined
+                                                                                    (cons name already-expanded)))
+                                                        out-line))))
+                           (macro-definition/function
+                            (if (and line (openp (first line)))
+                                (if (member name already-expanded :test (function string=))
+                                    (push token out-line)
+                                    (let (arguments)
+                                      (multiple-value-setq (arguments line tokenized-lines) (parse-function-macro-call-arguments token line tokenized-lines))
+                                      (setf out-line (nreconc (first (macro-expand-macros context (expand-macro-definition definition arguments)
+                                                                                          '() '() allow-defined
+                                                                                          (cons name already-expanded)))
+                                                              out-line))))
+                                (push token out-line))))))
+                      (t
+                       (push token out-line)))
+                (push token out-line))))
+    :finally (push (nreverse out-line) output-lines))
+  (values output-lines tokenized-lines))

 ;;;; THE END ;;;;
diff --git a/languages/cpp/cpp.lisp b/languages/cpp/cpp.lisp
index 66dfee1..64f84c1 100644
--- a/languages/cpp/cpp.lisp
+++ b/languages/cpp/cpp.lisp
@@ -784,9 +784,9 @@ RETURN: the token text; the end position."
 (defmethod include-common ((context context) directive)
   (with-cpp-line (context-current-line context)
     (if (context-current-line context)
-        (let ((line (first (macro-expand-macros (context-current-line context)
-                                                '() '() '()
-                                                (context-environment context))))) ; macro-functions must stand on a single line after #include/#import.
+        ;; macro-functions must stand on a single line after #include/#import.
+        (let ((line (first (macro-expand-macros context (context-current-line context)
+                                                '() '() nil '()))))
           (multiple-value-bind (path kind line) (extract-path directive line)
             (when path
               (perform-include context path kind directive))
@@ -821,26 +821,174 @@ RETURN: the token text; the end position."
      (cpp-error (first line) "Invalid macro name ~A after ~A" (token-text (first line)) where)
      nil)))

-
-(defmethod process-then-branch ((context context))
-  (incf (context-if-level context))
-  (process-file context))
-(defmethod process-else-branch ((context context))
-  context)
-(defmethod skip-then-branch ((context context))
-  context)
-(defmethod skip-else-branch ((context context))
-  context)
+(defmacro define-cpp-line-predicate (name key)
+  `(defun ,name (line)
+     (and (cdr line)
+          (sharpp (car line))
+          (string= ,key (token-text (cadr line))))))
+(define-cpp-line-predicate if-line-p     "if")
+(define-cpp-line-predicate ifdef-line-p  "ifdef")
+(define-cpp-line-predicate ifndef-line-p "ifndef")
+(define-cpp-line-predicate elif-line-p   "elif")
+(define-cpp-line-predicate else-line-p   "else")
+(define-cpp-line-predicate endif-line-p  "endif")
+
+(defmethod skip-if ((context context))
+  ;; PRE: current line is #if #ifdef #ifndef #elif or #else
+  ;; POST: current line is nil or #endif
+  ;; skips until the matching #endif
+  (let ((if-line (context-current-line context)))
+    (setf (context-current-line context) nil)
+    (incf (context-if-level context))
+    (unwind-protect
+         (loop
+           :while (context-input-lines context)
+           :do (let ((line (pop (context-input-lines context))))
+                 (cond ((or (if-line-p line)
+                            (ifdef-line-p line)
+                            (ifndef-line-p line))
+                        (skip-if context))
+                       ((endif-line-p line)
+                        (setf (context-current-line context) line)
+                        (return t))))
+           :finally (cpp-error if-line "End of file reached before a balanced #endif for #~A"
+                               (token-text (second if-line)))
+                    (return nil))
+      (decf (context-if-level context)))))
+
+(defmethod skip-branch ((context context))
+  ;; skips a single branch
+  ;; PRE:  current line is #if #ifdef #ifndef or #elif
+  ;; POST: current line is nil, #elif #else or #endif
+  (let ((if-line (context-current-line context)))
+    (setf (context-current-line context) nil)
+    (loop
+      :while (context-input-lines context)
+      :do (let ((line (pop (context-input-lines context))))
+            (cond ((or (if-line-p line)
+                       (ifdef-line-p line)
+                       (ifndef-line-p line))
+                   (skip-if context))
+                  ((or (elif-line-p line)
+                       (else-line-p line)
+                       (endif-line-p line))
+                   (setf (context-current-line context) line)
+                   (return t))))
+      :finally (cpp-error if-line "End of file reached before a balanced #endif for #~A"
+                          (token-text (second if-line)))
+               (return nil))))
+
+(defmethod process-branch-and-skip ((context context) &optional no-else)
+  ;; current line is #if #ifdef #ifndef or #elif
+  ;; processes the branch,
+  ;; and then skip the branches until #endif
+  ;; if no-else, the signals an error if a #else or #elif is found.
+  ;; (there should be no-else after an #else).
+  (flet ((check-no-else ()
+           (when no-else
+             (cpp-error (context-current-line context) "Found a #~A line after a #else"
+                        (token-text (second (context-current-line context)))))))
+    (process-file context) ; shall read the input-lines till the #elif #else or #endif
+    (loop
+      :while (elif-line-p (context-current-line context))
+      :do (check-no-else)
+          (skip-branch context))
+    (when (else-line-p (context-current-line context))
+      (check-no-else)
+      (skip-branch context))
+    (unless (or (null (context-current-line context))
+                (endif-line-p (context-current-line context)))
+      (check-no-else))
+    (loop
+      :until (or (null (context-current-line context))
+                 (endif-line-p (context-current-line context)))
+      :do (skip-branch context))))
+
+#-(and) (
+
+         (let ((*context*  (make-instance 'context
+                                          :current-line (list (make-punctuation "#") (make-identifier "ifdef") (make-identifier "YES"))
+                                          :input-lines  (list (list (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "else"))
+                                                              (list (make-number "2"))
+                                                              (list (make-punctuation "#") (make-identifier "endif")))
+                                          :if-level 1)))
+           (process-branch-and-skip *context*)
+           (write-processed-lines (reverse (context-output-lines *context*))))
+
+
+         (let ((*context*  (make-instance 'context
+                                          :input-lines  (list (list (make-punctuation "#") (make-identifier "define") (make-identifier "YES")  (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "ifdef") (make-identifier "YES"))
+                                                              (list (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "else"))
+                                                              (list (make-number "2"))
+                                                              (list (make-punctuation "#") (make-identifier "endif"))))))
+           (process-file *context*)
+           (write-processed-lines (reverse (context-output-lines *context*))))
+
+         (let ((*context*  (make-instance 'context
+                                          :input-lines  (list (list (make-punctuation "#") (make-identifier "define") (make-identifier "YES")  (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "ifdef") (make-identifier "NO"))
+                                                              (list (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "else"))
+                                                              (list (make-number "2"))
+                                                              (list (make-punctuation "#") (make-identifier "endif"))))))
+           (process-file *context*)
+           (write-processed-lines (reverse (context-output-lines *context*))))
+
+         (let ((*context*  (make-instance 'context
+                                          :input-lines  (list (list (make-punctuation "#") (make-identifier "define") (make-identifier "YES")  (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "ifdef") (make-identifier "NO"))
+                                                              (list (make-number "1"))
+                                                              (list (make-punctuation "#") (make-identifier "elif") (make-identifier "defined") (make-identifier "YES"))
+                                                              (list (make-number "2"))
+                                                              (list (make-punctuation "#") (make-identifier "else"))
+                                                              (list (make-number "3"))
+                                                              (list (make-punctuation "#") (make-identifier "endif"))))))
+           (process-file *context*)
+           (write-processed-lines (reverse (context-output-lines *context*))))
+
+
+
+
+
+         )
+
+
+(defmethod skip-branch-and-process ((context context))
+  ;; line is #if #ifdef #ifndef #elif
+  ;; skip the branches,
+  ;; and then process the next #elif or #else branch.
+  ;; and then skip the end.
+  ;; Note: #ifdef … #elif … #else … #endif is valid.
+  (skip-branch context)
+  (loop
+    :while (and (elif-line-p (context-current-line context))
+                (not (cpp-evaluate-expression context (cddr (context-current-line context)))))
+    :do (skip-branch context))
+  (if (elif-line-p (context-current-line context))
+      (process-branch-and-skip context)
+      (progn
+        (loop
+          :until (or (else-line-p (context-current-line context))
+                     (endif-line-p (context-current-line context)))
+          :do (skip-branch context))
+        (when (else-line-p (context-current-line context))
+          (process-branch-and-skip context :no-else)))))

 (defmethod ifdef-common ((context context) flip directive)
-  (let ((name (parse-single-macro-name (context-current-line context) directive)))
-    (cond
-      ((null name)
-       (skip-else-branch (skip-then-branch context)))
-      ((funcall flip (environment-macro-definedp (context-environment context) (token-text name)))
-       (skip-else-branch (process-then-branch context)))
-      (t
-       (process-else-branch (skip-then-branch context))))))
+  (incf (context-if-level context))
+  (unwind-protect
+       (let ((name (parse-single-macro-name (cddr (context-current-line context)) directive)))
+         (cond
+           ((null name)
+            (skip-if context))
+           ((funcall flip (environment-macro-definedp (context-environment context) (token-text name)))
+            (process-branch-and-skip context))
+           (t
+            (skip-branch-and-process context))))
+    (decf (context-if-level context))))

 (defmethod ifdef ((context context))
   (ifdef-common context (function identity) "#ifdef"))
@@ -848,9 +996,16 @@ RETURN: the token text; the end position."
 (defmethod ifndef ((context context))
   (ifdef-common context (function not) "#ifndef"))

+(defun cpp-evaluate-expression (context line)
+  (not (zerop (eval (parse-expression context
+                                      (first (macro-expand-macros context line
+                                                                  '() '() :allow-defined '())))))))
+
 (defmethod cpp-if ((context context))
-
-  )
+  (if (cpp-evaluate-expression context (cddr (context-current-line context)))
+      (process-branch-and-skip context)
+      (skip-branch-and-process context)))
+

 ;;; --------------------
 ;;; #line
@@ -901,306 +1056,14 @@ RETURN: the token text; the end position."
 ;;; pre-processing files
 ;;; --------------------

-#|
-
-object-like macros
-------------------
-
-- The macro definition is a single line of token.
-
-- When the macro is expanded, the expansion is macroexpanded:
-
-       #undef FOO
-       #undef BAR
-       #define FOO BAR
-       int i[]={ FOO,
-       #undef BAR
-       #define BAR 1
-                 FOO,
-       #undef BAR
-       #define BAR 2
-                 FOO };
-    -->
-        int i[]={ BAR,
-
-
-                  1,
-
-
-                  2 };
-
-- But happily, an object-like macro cannot expand to a partial
-  function-like macro invocation:
-
-        #define LEFT F("l",
-        #define RIGHT ,"r")
-        #define FOO LEFT "foo" RIGHT
-        1: FOO; /* ok, FOO expands to F("l","foo","r") */
-        #define F(a,b,c) a##b##c
-        // 2: FOO; /* good: error: unterminated argument list invoking macro "F" (in expanding LEFT from FOO)*/
-
-- Recursive expansion is detected and prevented.
-
-Therefore we can process object-like macro expansions independently.
-
-
-
-function-like macros
---------------------
-
-This is crazy.
-
-- macro arguments are macro-expanded before they are substituted in the macro body,
-  but not for their stringify and token concatenation use:
-
-        #define VOO 42
-        #define F(X) #X[X]
-
-        F(33)
-        F(VOO)
-        F(C(VOO,VOO))
-    -->
-        "33"[33]
-        "VOO"[42]
-        "C(VOO,VOO)"[VOOVOO]
-
-   So basically, we need to pass the arguments under two forms.
-
-
-   "If an argument is stringified or concatenated, the prescan does
-    not occur. If you want to expand a macro, then stringify or
-    concatenate its expansion, you can do that by causing one macro to
-    call another macro that does the stringification or
-    concatenation."
-  This doesn't sound right, from the above test.
-
-
-- after substitution the entire macro expansion is again scanned for
-  macros to be expanded.
-
-- The self-references that do not expand in the first scan are marked
-  so that they will not expand in the second scan either. !!!
-
-- but happily again, a function-like macro cannot expand to a partial
-  function-like macro invocation, so we can also perform this later
-  expansion independently.
-
-  But "toplevel" function-like macro calls can span several lines,
-  including pre-processor directives (#ifs, #defines, #includes, etc).
-  So parsing function-like macros calls must take into account several
-  lines, and may have to perform recursive directive processing
-
-
-        #undef LEFT
-        #undef RIGHT
-        #undef FOO
-        #undef F
-        #define FOO(E) F(l,E,r)
-        1: FOO(foo); /* ok */
-        #define F(a,b,c) a##b##c
-        2: FOO(bar); /* ok since FOO(E) contains the whole F() call. */
-        3: FOO(
-        #define F(a,b,c) a##a
-               baz
-        #undef F
-        #define F(a,b,c) c##c
-               );
-        4: FOO(
-        #undef F
-        #define F(a,b,c) a##a
-               FOO(baz)
-        #undef F
-        #define F(a,b,c) c##c
-               );
-    -->
-        1: F(l,foo,r);
-
-        2: lbarr;
-
-        3: rr
-
-
-
-
-                ;
-        4: rr
-
-
-
-
-
-                ;
-
-    Note: the result 4!  The arguments are macro expanded only when
-    the macro call F() is being computed, ie. after we've seen the
-    closing parenthesis.
-
-
-- macro arguments must be parenthesis-balanced (only (), not {} or []).
-  Within (), commas don't split arguments:
-
-        #define F(X) ((X)+(X))
-        F((1,2))
-    -->
-        ((1,2)+(1,2)) /* == 4 */
-
-- unshielded commas in macro arguments are used as argument separators:
-
-      #define foo a,b
-      #define bar(x) lose(x)
-      #define lose(x) (1+(x))
-      bar(foo) --> lose(a,b) /* wrong argument count */
-
-- arguments may be empty.
-
-      #define foo(a,b) {(0,a),(1,b)}
-    -->
-      foo(,) --> {(0,),(1,)}
-
-
-- cf. variadic parameters.
-
-ambiguity, with:
-    #define f() foo
-    #define g(x) bar
-then
-    f() g()
-have different argument counts :-)
-
-concatenation
--------------
-
-    However, two tokens that don't together form a valid token cannot
-    be pasted together. For example, you cannot concatenate x with +
-    in either order. If you try, the preprocessor issues a warning and
-    emits the two tokens.
-
-    Also, ## concatenates only the first or last token of the argument:
-        #define CONCAT(A,B) A ## B
-        CONCAT(a b,c d)
-    -->
-        a bc d /* 3 tokens */
-
-    If the argument is empty, that ‘##’ has no effect.
-
-|#
-
-
-(defmacro skip-nil (block-name macro-name-token-var line-var tokenized-lines-var)
-  `(loop :while (null ,line-var)
-         :do (if (null ,tokenized-lines-var)
-                 (progn
-                   (cpp-error *context* "Reached end of file in function-like macro call ~A"
-                              (token-text ,macro-name-token-var))
-                   (return-from ,block-name nil))
-                 (setf ,line-var (pop ,tokenized-lines-var)))))
-
-(defmacro expect (macro-name-token-var token-predicate-name line-var tokenized-lines-var)
-  `(block expect
-     (skip-nil expect ,macro-name-token-var ,line-var ,tokenized-lines-var)
-     (if (,token-predicate-name (first ,line-var))
-         (return-from expect (pop ,line-var))
-         (progn
-           (cpp-error (first ,line-var) "Expected a ~A in function-like macro call ~A, not ~A"
-                      (token-predicate-label ',token-predicate-name)
-                      (token-text ,macro-name-token-var)
-                      (token-text (first ,line-var)))
-           (return-from expect nil)))))
-
-(defun parse-function-macro-call-arguments (macro-name-token line tokenized-lines)
-  ;; function-macro-call     ::= macro-name '(' arglist  ')' .
-  ;; arglist                 ::= argument | argument ',' arglist .
-  ;; argument                ::= | argument-item argument .
-  ;; argument-item           ::= non-parenthesis-or-comma-token | parenthesized-item-list .
-  ;; parenthesized-item-list ::= '(' item-list ')' .
-  ;; item-list               ::= | non-parenthesis-or-comma-token | ',' | parenthesized-item-list .
-  (labels ((skip-nil-not-eof-p ()
-             (block skip
-               (skip-nil skip macro-name-token line tokenized-lines)
-               t))
-           (arglist ()
-             (loop
-               :collect (parse-argument)
-               :while (and (skip-nil-not-eof-p)
-                           (commap (first line)))
-               :do (pop line)))
-           (parenthesized-item-list ()
-             (let ((left  (expect macro-name-token openp line tokenized-lines))
-                   (items (item-list))
-                   (right (or (expect macro-name-token closep line tokenized-lines)
-                              (list (make-punctuation ")" 1 1 "-")))))
-               (nconc (list left) items (list right))))
-           (item-list ()
-             (loop
-               :while (and (skip-nil-not-eof-p)
-                           (not (closep (first line))))
-               :if (openp (first line))
-                 :append (parenthesized-item-list)
-               :else
-                 :collect (pop line)))
-           (parse-argument-item ()
-             (cond
-               ((openp (first line))
-                (parenthesized-item-list))
-               ((commap (first line))
-                '())
-               (t
-                (list (pop line)))))
-           (parse-argument ()
-             (when (skip-nil-not-eof-p)
-               (if (commap (first line))
-                   '()
-                   (loop
-                     :while (and (skip-nil-not-eof-p)
-                                 (not (commap (first line)))
-                                 (not (closep (first line))))
-                     :nconc (parse-argument-item))))))
-    (if (expect macro-name-token openp line tokenized-lines)
-        (values (let ((arglist (arglist)))
-                  (unless (expect macro-name-token closep line tokenized-lines)
-                    (setf line nil))
-                  arglist)
-                line
-                tokenized-lines)
-        (values '() line tokenized-lines))))
-
-
-(defun macro-expand-macros (line tokenized-lines output-lines already-expanded environment)
-  (loop
-    :with out-line := '()
-    :while line
-    :do (let* ((token (pop line))
-               (name  (and token (token-text token))))
-          (if (and (identifierp token)
-                   (environment-macro-definedp environment name))
-              (let ((definition (environment-macro-definition environment name)))
-                (etypecase definition
-                  (macro-definition/object
-                   (setf out-line (nreconc (first (macro-expand-macros (expand-macro-definition definition)
-                                                                       '() '()
-                                                                       (cons name already-expanded)
-                                                                       environment))
-                                           out-line)))
-                  (macro-definition/function
-                   (if (and line (openp (first line)))
-                       (let (arguments)
-                         (multiple-value-setq (arguments line tokenized-lines) (parse-function-macro-call-arguments token line tokenized-lines))
-                         (setf out-line (nreconc (first (macro-expand-macros (expand-macro-definition definition arguments)
-                                                                             '() '()
-                                                                             (cons name already-expanded)
-                                                                             environment))
-                                                 out-line)))
-                       (push token out-line)))))
-              (push token out-line)))
-    :finally (push (nreverse out-line) output-lines))
-  (values output-lines tokenized-lines))

 (defmethod cpp-macro-expand ((context context))
-  (multiple-value-bind (output input) (macro-expand-macros (context-current-line context)
+  (multiple-value-bind (output input) (macro-expand-macros context
+                                                           (context-current-line context)
                                                            (context-input-lines context)
                                                            (context-output-lines context)
-                                                           (context-macros-being-expanded context)
-                                                           (context-environment context))
+                                                           nil
+                                                           (context-macros-being-expanded context))
     (setf (context-output-lines context) output
           (context-input-lines context) input)
     context))
@@ -1224,10 +1087,9 @@ concatenation
                    (("ifndef")  (ifndef  context))
                    (("if")      (cpp-if  context))
                    (("elif" "else" "endif")
-                    (when (plusp (context-if-level context))
-                      (push line (context-input-lines context))
-                      (loop-finish))
-                    (cpp-error (second line) "#~A without #if" (token-text (second line))))
+                    (if (plusp (context-if-level context))
+                        (return)
+                        (cpp-error (second line) "#~A without #if" (token-text (second line)))))
                    (("line")    (cpp-line context))
                    (("pragma")  (pragma           context))
                    (("error")   (cpp-error-line   context))
@@ -1240,7 +1102,8 @@ concatenation
                  (cpp-error line "invalid directive #~A" (token-text (second line))))
                 (t ;; skip # alone.
                  ))
-              (cpp-macro-expand context))))
+              (cpp-macro-expand context)))
+    :finally (setf (context-current-line context) nil))
   context)

 (defmethod read-and-process-file ((context context) path)
@@ -1509,6 +1372,13 @@ concatenation
                  '("..." 12)))
   :success)

+(defun test/scan-delimited-literal ()
+  (assert (equal (multiple-value-list (scan-delimited-literal '("'e'" 42 "test.c") 0))
+                 '("'e'" 3)))
+  (assert (equal (multiple-value-list (scan-delimited-literal '("'\\x41'" 42 "test.c") 0))
+                 '("'\\x41'" 6)))
+  :success)
+
 (defun text/skip-spaces ()
   (assert (equal (skip-spaces "    xyz()" 0) 4))
   (assert (equal (skip-spaces "    xyz()" 7) 7))
@@ -1622,9 +1492,12 @@ concatenation
   (test/scan-identifier)
   (test/scan-number)
   (test/scan-punctuation)
+  (test/scan-delimited-literal)
   (text/skip-spaces)
   (test/extract-path)
-  (test/parse-function-macro-call-arguments))
+  (test/parse-function-macro-call-arguments)
+  (test/character-value)
+  (test/integer-value))

 (test/all)

diff --git a/languages/cpp/expression.lisp b/languages/cpp/expression.lisp
new file mode 100644
index 0000000..769f8f2
--- /dev/null
+++ b/languages/cpp/expression.lisp
@@ -0,0 +1,243 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               expression.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Parses and evaluates cpp #if expressions.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-07-01 <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 integer-value (integer-token)
+  (let ((integer-text (token-text integer-token)))
+    (cond
+      ((and (< 2 (length integer-text))
+            (string= "0x" integer-text :start2 0 :end2 2))
+       (or (ignore-errors (parse-integer integer-text :start 2 :radix 16 :junk-allowed nil))
+           (progn
+             (cpp-error integer-token "Invalid hexadecimal integer syntax in ~S" integer-text)
+             0)))
+      ((and (< 2 (length integer-text))
+            (string= "0b" integer-text :start2 0 :end2 2))
+       (or (ignore-errors (parse-integer integer-text :start 2 :radix 2 :junk-allowed nil))
+           (progn
+             (cpp-error integer-token "Invalid binary integer syntax in ~S" integer-text)
+             0)))
+      ((and (< 1 (length integer-text))
+            (string= "0" integer-text :start2 0 :end2 1))
+       (or (ignore-errors (parse-integer integer-text :start 1 :radix 8 :junk-allowed nil))
+           (progn
+             (cpp-error integer-token "Invalid octal integer syntax in ~S" integer-text)
+             0)))
+      (t
+       (or (ignore-errors (parse-integer integer-text :junk-allowed nil))
+           (progn
+             (cpp-error integer-token "Invalid decimal integer syntax in ~S" integer-text)
+             0))))))
+
+(defun character-value (character-token)
+  (let* ((character-text (token-text character-token))
+         (character-string
+           (with-input-from-string (in character-text :start 1)
+             (read-c-string in #\'))))
+    (unless (= 1 (length character-string))
+      (cpp-error character-token "Invalid multi-byte character literal ~A" character-text)
+      (when (zerop (length character-string))
+        (setf character-string #(#\nul))))
+    (char-code (aref character-string 0))))
+
+(defmacro with-binary-op-parsers ((&rest definitions) (&rest functions) &body body)
+  `(labels (,@(mapcar (lambda (definition)
+                        (destructuring-bind (name subexpr &rest ops) definition
+                          `(,name () (loop :with expr := (,subexpr)
+                                           :while ,(if (= 1 (length ops))
+                                                       `(,(first (first ops)) (peek))
+                                                       `(let ((next (peek)))
+                                                          (some (lambda (pred) (funcall pred next))
+                                                                ',(mapcar (function first) ops))))
+                                           :do (setf expr (list ,(if (= 1 (length ops))
+                                                                     `(progn (eat) ',(second (first ops)))
+                                                                     `(let ((op (eat)))
+                                                                        (cond
+                                                                          ,@(mapcar (lambda (pair)
+                                                                                      `((,(first pair) op) (quote ,(second pair))))
+                                                                                    ops))))
+                                                                expr (,subexpr)))
+                                           :finally (return expr)))))
+                definitions)
+            ,@functions)
+     ,@body))
+
+  #|
+
+  integer constant
+  character constant (interpreted as in C, as numbers)
+  arithmetic operators + - * / % ^ & | ~  << >>  < <= > >= != ==  && || !
+  macros are expanded
+  defined(macro-name)
+  _Pragma("pragma")
+  identifiers = 0 (warning on -Wunder)
+
+  calculations in the widest integer type known to the compiler; on most machines supported by GCC this is 64 bits
+
+  operator precedence:
+  2 + - ! ~ unary
+  3 * / %
+  4 + - binary
+  5 <<>>
+  6 < <= > >=
+  7 == !=
+  8 &
+  9 ^
+  10 |
+  11 &&
+  12 ||
+
+  expr ::= expr12 .
+  expr12 ::= expr11 [ '||' expr12 ] .
+  expr11 ::= expr10 [ '&&' expr11 ] .
+  expr10 ::= expr9 [ '|' expr10 ] .
+  expr9 ::= expr8 [ '^' expr9 ] .
+  expr8 ::= expr7 [ '&' expr8 ] .
+  expr7 ::= expr6 [ ( '==' | '!=' ) expr7 ] .
+  expr6 ::= expr5 [ ( '<' | '<=' | '>' | '>=' ) expr6 ] .
+  expr5 ::= expr4 [ ( '<<' | '>>' ) expr5 ] .
+  expr4 ::= expr3 [ ( '+' | '-' ) expr4 ] .
+  expr3 ::= expr2 [ ( '*' | '/' | '%' ) expr3 ] .
+  expr2 ::= [ '+' | '-' | '!' | '~' ] expr1 .
+  expr1 ::= '_Pragma' '(' string ')'
+          | 'defined' '(' identifier ')'
+          | '(' expr12 ')'
+          | integer | character | identifier .
+
+  associativity of binary operations: left-to-right.
+
+  |#
+
+(defmacro cpp-and (a b)
+  `(if (and (not (zerop ,a)) (not (zerop ,b)))
+       1 0))
+
+(defmacro cpp-or (a b)
+  `(if (or (not (zerop ,a)) (not (zerop ,b)))
+       1 0))
+
+(defun cpp-not (a)   (if (zerop a) 1 0))
+(defun cpp-<   (a b) (if (<  a b)  1 0))
+(defun cpp-<=  (a b) (if (<= a b)  1 0))
+(defun cpp->   (a b) (if (>  a b)  1 0))
+(defun cpp->=  (a b) (if (>= a b)  1 0))
+(defun cpp-=   (a b) (if (=  a b)  1 0))
+(defun cpp-/=  (a b) (if (/= a b)  1 0))
+
+(defun left-shift  (value offset)
+  (ash value offset))
+
+(defun right-shift (value offset)
+  (ash value (- offset)))
+
+(defmethod parse-expression ((context context) line)
+  (with-binary-op-parsers ((expr12 expr11 (op-logior-p cpp-or))
+                           (expr11 expr10 (op-logand-p cpp-and))
+                           (expr10 expr9  (op-bitior-p logior))
+                           (expr9  expr8  (op-bitxor-p logxor))
+                           (expr8  expr7  (op-bitand-p logand))
+                           (expr7  expr6  (op-eq-p cpp-=) (op-ne-p cpp-/=))
+                           (expr6  expr5  (op-lt-p cpp-<) (op-le-p cpp-<=) (op-gt-p cpp->) (op-ge-p cpp->=))
+                           (expr5  expr4  (op-left-shift-p left-shift) (op-right-shift-p right-shift))
+                           (expr4  expr3  (op-plus-p +) (op-minus-p -))
+                           (expr3  expr2  (op-times-p *) (op-divides-p truncate)  (op-remainder-p mod)))
+      ((expr2 ()
+              (let ((op (peek)))
+                (cond ((op-plus-p op)   (eat) (expr1))
+                      ((op-minus-p op)  (eat) `(- ,(expr1)))
+                      ((op-lognot-p op) (eat) `(cpp-not ,(expr1)))
+                      ((op-bitnot-p op) (eat) `(lognot ,(expr1)))
+                      (t                      (expr1)))))
+       (expr1 ()
+              ;; expr2 ::= '_Pragma' '(' string ')'
+              ;;         | 'defined' '(' identifier ')'
+              ;;         | '(' expr12 ')'
+              ;;         | identifier [ '(' arguments… ')' ]
+              ;;         | integer
+              ;;         | character .
+              (let ((next (peek)))
+                (cond
+                  ((openp next)
+                   (eat)
+                   (prog1 (expr12)
+                     (if (closep (peek))
+                         (eat)
+                         (progn (cpp-error next "Missing close parenthesis in #if expression, got ~S instead" (token-text (eat)))
+                                (return-from parse-expression 0)))))
+                  ((number-p next)
+                   (integer-value (eat)))
+                  ((character-literal-p next)
+                   (character-value (token-text (eat))))
+                  ((identifierp next)
+                   (let ((identifier (eat)))
+                     (scase (token-text identifier)
+                       (("_Pragma")
+                        (cpp-error identifier "_Pragma is forbidden in #if expressions")
+                        0)
+                       (otherwise ;; we've already macroexpanded
+                        (when (option context :warn-on-undefined-identifier)
+                          (cpp-warning identifier "~S is not defined" (token-text identifier)))
+                        0))))
+                  (t (if next
+                         (cpp-error next "token ~S is not valid in preprocessor expressions" (token-text next))
+                         (cpp-error context "end of line reached before the end of the preprocessor expressions"))
+                     (return-from parse-expression 0)))))
+       (eat  () (pop   line))
+       (peek () (first line)))
+    (prog1 (expr12)
+      (unless (null (peek))
+        (cpp-error (peek) "missing binary operator before token ~S" (eat))))))
+
+
+
+(defun test/integer-value ()
+  (assert (equal (mapcar (function integer-value)
+                         (list (make-number "42"          0 0 "-")
+                               (make-number "0x42"        0 0 "-")
+                               (make-number "0b101010"    0 0 "-")
+                               (make-number "042"         0 0 "-")))
+                 '(42 66 42 34)))
+  :success)
+
+(defun test/character-value ()
+  (assert (equal (mapcar (function character-value)
+                         (list (make-character-literal "'A'"      0 0 "-")
+                               (make-character-literal "'\\x41'"  0 0 "-")
+                               (make-character-literal "'\\n'"    0 0 "-")
+                               (make-character-literal "'λ'"      0 0 "-")))
+
+                 '(65 65 10 955)))
+  :success)
+
+;;;; THE END ;;;;
diff --git a/languages/cpp/tests/Makefile b/languages/cpp/tests/Makefile
index 2128953..481c6eb 100644
--- a/languages/cpp/tests/Makefile
+++ b/languages/cpp/tests/Makefile
@@ -27,4 +27,8 @@ errors:
 	gcc -E -o - errors.c
 line:
 	gcc -E -o - line.c
+ifdef:
+	gcc -E -o - ifdef.c | cat -s
+if:
+	gcc -E -o - -Wundef if.c | cat -s

diff --git a/languages/cpp/tests/if.c b/languages/cpp/tests/if.c
new file mode 100644
index 0000000..9b4377d
--- /dev/null
+++ b/languages/cpp/tests/if.c
@@ -0,0 +1,72 @@
+#define DEFINED
+
+#if defined(UNDEFINED)
+defined.bad.1;
+#endif
+#if defined (UNDEFINED)
+defined.bad.2;
+#endif
+#if defined UNDEFINED
+defined.bad.3;
+#endif
+
+
+#if defined(DEFINED)  // doesn't macroexpand DEFINED.
+defined.good.1;
+#endif
+#if defined (DEFINED)
+defined.good.2;
+#endif
+#if defined DEFINED
+defined.good.3;
+#endif
+
+#define GOOD_SYM GOOD_SYM
+#define DEF(X) defined(X)
+#if DEF(GOOD_SYM) // substitues GOOD_SYM as argument when macroexpanding DEF(GOOD_SYM)
+def.good;
+#endif
+#if DEF(UNDEFINED)
+def.bad;
+#endif
+
+
+#define STRANGE "Hello"
+
+#if STRANGE
+strange.bad.then;
+#else
+strange.good.else;
+#endif
+
+#if foo
+foo.bad.then;
+#else
+foo.good.else;
+#endif
+
+#define GOOD 1
+#if GOOD will
+good.good.then;
+#endif
+
+#define height 24
+#define width 80
+#if !((height-1)*(width/2) < 3<<4) || (1/0)
+expr.good.then;
+#else
+expr.bad.else;
+#endif
+
+#define a 1
+#define b 2
+#define c 3
+#define d 4
+#if (-a + +b + ~c + !d) - a - b + c + d * d / c % b << 3 - c >> 1 < a <= b > c >= d == a != b & c ^ d | a && 1 || 0
+guess.then;
+#else
+guess.else;
+#endif
+
+int x=defined(GOOD_SYM);
+int y=defined(GOOD);
diff --git a/languages/cpp/tests/ifdef.c b/languages/cpp/tests/ifdef.c
new file mode 100644
index 0000000..efb9fbd
--- /dev/null
+++ b/languages/cpp/tests/ifdef.c
@@ -0,0 +1,114 @@
+#define YES
+#define TRUE 1
+
+#ifdef YES
+ifdef.yes.good1;
+#endif
+
+#ifdef YES
+ifdef.yes.good2;
+#else
+ifdef.yes.bad2;
+#endif
+
+#ifdef YES
+ifdef.yes.good3;
+#else
+ifdef.yes.bad3;
+#else
+ifdef.yes.bad3b;
+#endif
+
+#ifdef YES
+ifdef.yes.good4;
+#elif TRUE
+ifdef.yes.bad4b;
+#else
+ifdef.yes.bad4c;
+#endif
+
+
+#ifdef NO
+ifdef.no.bad5;
+#endif
+no good5;
+
+#ifdef NO
+ifdef.no.bad6;
+#else
+ifdef.no.good6;
+#endif
+
+#ifdef NO
+ifdef.no.bad7;
+#else
+ifdef.no.good7;
+#else
+ifdef.no.bad7b;
+#endif
+
+#ifdef NO
+ifdef.no.bad8;
+#elif TRUE
+ifdef.no.good8b;
+#else
+ifdef.no.good8;
+#endif
+
+
+
+#ifndef NO
+ifndef.no.good1;
+#endif
+
+#ifndef NO
+ifndef.no.good2;
+#else
+ifndef.no.bad2;
+#endif
+
+#ifndef NO
+ifndef.no.good3;
+#else
+ifndef.no.bad3;
+#else
+ifndef.no.bad3b;
+#endif
+
+#ifndef NO
+ifndef.no.good4;
+#elif TRUE
+ifndef.no.bad4b;
+#else
+ifndef.no.bad4c;
+#endif
+
+
+#ifndef YES
+ifndef.yes.bad5;
+#endif
+no good5;
+
+#ifndef YES
+ifndef.yes.bad6;
+#else
+ifndef.yes.good6;
+#endif
+
+#ifndef YES
+ifndef.yes.bad7;
+#else
+ifndef.yes.good7;
+#else
+ifndef.yes.bad7b;
+#endif
+
+#ifndef YES
+ifndef.yes.bad8;
+#elif TRUE
+ifndef.yes.good8b;
+#else
+ifndef.yes.good8c;
+#endif
+
+
diff --git a/languages/cpp/tests/recursive.c b/languages/cpp/tests/recursive.c
index 84c9e0d..320992a 100644
--- a/languages/cpp/tests/recursive.c
+++ b/languages/cpp/tests/recursive.c
@@ -2,11 +2,19 @@
 #define BAR VOO - 1

 #define f(x,y,z) x,f(y,z,x)
+#define G(x,y,z) g(y,z,x)
+#define g(x,y,z) x,G(x,y,z)

 int x=VOO;
 int[] y={f(1,2,3)};
+int[] z={g(1,2,3)};


+#define SUCC(X) (1+(X))
+int f2=SUCC(SUCC(0));
+
+#define TWO SUCC(SUCC(0))
+int f3=SUCC(TWO);

 #undef FOO
 #undef BAR
diff --git a/languages/cpp/token.lisp b/languages/cpp/token.lisp
index bc17300..b3efccf 100644
--- a/languages/cpp/token.lisp
+++ b/languages/cpp/token.lisp
@@ -78,7 +78,7 @@
             (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)
+       (defun ,(intern (concatenate 'string (string 'make-) (string name))) (text &optional (column 0) (line 0) (file "-"))
          (make-instance ',class-name :text text :column column :line line :file file)))))

 (define-token-class identifier)
@@ -106,41 +106,41 @@
     (number-token-p  "a number")
     (otherwise (format nil "a ~(~A~)"  predicate-name))))

-(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)))))
+(defmacro define-punctuation-predicate (name value)
+  `(defun ,name (token)
+     (and (typep token 'punctuation-token)
+          (or (string= ,value  (token-text token))))))
+
+(define-punctuation-predicate sharpp           "#")
+(define-punctuation-predicate sharpsharpp      "##")
+(define-punctuation-predicate spacep           " ")
+(define-punctuation-predicate openp            "(")
+(define-punctuation-predicate closep           ")")
+(define-punctuation-predicate open-bracket-p   "<")
+(define-punctuation-predicate close-bracket-p  ">")
+(define-punctuation-predicate commap           ",")
+(define-punctuation-predicate ellipsisp        "...")
+
+(define-punctuation-predicate op-plus-p        "+")
+(define-punctuation-predicate op-minus-p       "-")
+(define-punctuation-predicate op-lognot-p      "!")
+(define-punctuation-predicate op-bitnot-p      "~")
+(define-punctuation-predicate op-times-p       "*")
+(define-punctuation-predicate op-divides-p     "/")
+(define-punctuation-predicate op-remainder-p   "%")
+(define-punctuation-predicate op-left-shift-p  "<<")
+(define-punctuation-predicate op-right-shift-p ">>")
+(define-punctuation-predicate op-lt-p          "<")
+(define-punctuation-predicate op-le-p          "<=")
+(define-punctuation-predicate op-gt-p          ">")
+(define-punctuation-predicate op-ge-p          ">=")
+(define-punctuation-predicate op-eq-p          "==")
+(define-punctuation-predicate op-ne-p          "!=")
+(define-punctuation-predicate op-bitand-p      "&")
+(define-punctuation-predicate op-bitior-p      "|")
+(define-punctuation-predicate op-bitxor-p      "^")
+(define-punctuation-predicate op-logand-p      "&&")
+(define-punctuation-predicate op-logior-p      "||")


 (defun identifierp (token)
@@ -156,31 +156,48 @@
 (define-condition cpp-warning (simple-warning)
   ())

-(defun cpp-error (token format-control &rest format-arguments)
-  (let ((*context* (if (typep token 'context)
-                       token
-                       (update-context *context* :token token
-                                                 :line (token-line token)
-                                                 :column (token-column token)
-                                                 :file (token-file token)))))
+(defgeneric cpp-error (token format-control &rest format-arguments)
+  (:method ((context context) format-control &rest format-arguments)
     (cerror "Continue" 'cpp-error
             :format-control "~A:~A: error: ~?"
             :format-arguments (list (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
-                       (update-context *context* :token token
-                                                 :line (token-line token)
-                                                 :column (token-column token)
-                                                 :file (token-file token)))))
+                                    format-control format-arguments)))
+  (:method ((token token) format-control &rest format-arguments)
+    (apply (function cpp-error)
+           (update-context *context* :token token
+                                     :line (token-line token)
+                                     :column (token-column token)
+                                     :file (token-file token))
+           format-control format-arguments))
+  (:method ((line cons) format-control &rest format-arguments)
+    (apply (function cpp-error) (first line) format-control format-arguments))
+  (:method ((line null) format-control &rest format-arguments)
+    (error 'cpp-error
+           :format-control format-control
+           :format-arguments  format-arguments)))
+
+
+(defgeneric cpp-warning (token format-control &rest format-arguments)
+  (:method ((context context) format-control &rest format-arguments)
     (warn 'cpp-warning
           :format-control "~A:~A: warning: ~?"
           :format-arguments (list (context-file *context*)
                                   (context-line *context*)
-                                  format-control format-arguments))))
+                                  format-control format-arguments)))
+  (:method ((token token) format-control &rest format-arguments)
+    (apply (function cpp-warning)
+           (update-context *context* :token token
+                                     :line (token-line token)
+                                     :column (token-column token)
+                                     :file (token-file token))
+           format-control format-arguments))
+  (:method ((line cons) format-control &rest format-arguments)
+    (apply (function cpp-warning) (first line) format-control format-arguments))
+  (:method ((line null) format-control &rest format-arguments)
+    (warn 'cpp-warning
+          :format-control format-control
+          :format-arguments  format-arguments)))


ViewGit