[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 87e7390: * lisp/progmodes/hideif.el: update for new C++ standards
|
From: |
Luke Lee |
|
Subject: |
master 87e7390: * lisp/progmodes/hideif.el: update for new C++ standards and extensions |
|
Date: |
Wed, 2 Jun 2021 08:30:46 -0400 (EDT) |
branch: master
commit 87e7390aaef0978bdef6f3b73af43305fab7db21
Author: Luke Lee <luke.yx.lee@gmail.com>
Commit: Luke Lee <luke.yx.lee@gmail.com>
* lisp/progmodes/hideif.el: update for new C++ standards and extensions
Matching gcc/clang behavior on stringification including keeping the same
number of white spaces. C++11, C++14, C++17 and GCC literals extension are
supported. Preprocessing time floating point operation supported but
limited
to Emacs internal representation which is C data type "double". Also
support
some frequently used keywords like __LINE__, __TIME__, __DATE__ and so on.
(hif-clear-all-ifdef-defined, hif-show-all, hif-after-revert-function)
(hide-ifdef-define, hide-ifdefs, show-ifdefs): interactive behavior changes,
mainly to allow operation within the marked region.
(hif-eval, hif-__LINE__, hif-__FILE__, hif-__COUNTER__, hif-__cplusplus)
(hif-__DATE__, hif-__TIME__, hif-__STDC__, hif-__STDC_VERSION__)
(hif-__STDC_HOST__, hif-__FILE__, hif-full-match, hif-is-number,
hif-is-float)
(hif-delete-char-in-string, hif-string-to-decfloat, hif-string-to-hexfloat)
(hif-strtok, hif-is-white, hif-backward-comment, hif-split-signed-token)
(hif-keep-single, hif-display-macro): new functions.
(hide-ifdef-verbose, hide-ifdef-evalulate-enter-hook)
(hide-ifdef-evalulate-leave-hook, hide-ifdef-evaluator, hif-predefine-alist)
(hif-numtype-suffix-regexp, hif-bin-regexp, hif-hex-regexp, hif-oct-regexp)
(hif-dec-regexp, hif-decfloat-regexp, hif-hexfloat-regexp)
(hif-unicode-prefix-regexp, hif-verbose-define-count): new constants or
variables.
(hif-macroref-regexp, hif-token-alist, hif-token-regexp)
(hif-string-literal-regexp): modified constants for faster regexp
processing.
(hide-ifdef-expand-reinclusion-guard): renamed from
`hide-ifdef-expand-reinclusion-protection' to match commonly used term.
(hif-lookup, hif-defined, hif-string-to-number, hif-tokenize, hif-nextoken)
(hif-if-valid-identifier-p, hif-define-operator, hif-expand-token-list)
(hif-parse-exp, hif-math, hif-factor, hif-get-argument-list, hif-stringify)
(hif-token-concat, hif-mathify, hif-comma, hif-token-stringification)
(hif-token-concatenation, hif-macro-supply-arguments, hif-evaluate-macro)
(hif-find-define, hif-add-new-defines, hide-ifdef-guts, hif-undefine-symbol)
(hide-ifdef-set-define-alist, hide-ifdef-use-define-alist): modified
functions
for new internal data representation, mainly for stringification and white
space preservation. Also better error handling to report source line number
and more informative error messages.
---
lisp/progmodes/hideif.el | 1214 +++++++++++++++++++++++++++++++++++-----------
1 file changed, 934 insertions(+), 280 deletions(-)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 0d9b4b7..956a7d9 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -55,10 +55,10 @@
;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol.
;;
;; If you define or undefine a symbol while hide-ifdef-mode is in effect,
-;; the display will be updated. Only the define list for the current
-;; buffer will be affected. You can save changes to the local define
-;; list with hide-ifdef-set-define-alist. This adds entries
-;; to hide-ifdef-define-alist.
+;; the display will be updated. The global define list hide-ifdef-env
+;; is affected accordingly. You can save changes to this globally define
+;; list with hide-ifdef-set-define-alist. This adds entries to
+;; hide-ifdef-define-alist.
;;
;; If you have defined a hide-ifdef-mode-hook, you can set
;; up a list of symbols that may be used by hide-ifdefs as in the
@@ -68,10 +68,19 @@
;; (lambda ()
;; (unless hide-ifdef-define-alist
;; (setq hide-ifdef-define-alist
-;; '((list1 ONE TWO)
-;; (list2 TWO THREE))))
+;; '((list1 (ONE . 1) (TWO . 2))
+;; (list2 (TWO . 2) (THREE . 3)))))
;; (hide-ifdef-use-define-alist 'list2))) ; use list2 by default
;;
+;; Currently recursive #include is not yet supported, a quick and reliable
+;; way is to let the compiler generates all the #include-d defined macros
+;; into a file, then open it in Emacs with hide-ifdefs (C-c @ h).
+;; Take gcc and hello.c for example, hello.c #include-s <stdio.h>:
+;;
+;; $ gcc -dM -E hello.c -o hello.hh
+;;
+;; Then, open hello.hh and perform hide-ifdefs.
+;;
;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify
;; another list to use.
;;
@@ -99,7 +108,11 @@
;; Extensively modified by Daniel LaLiberte (while at Gould).
;;
;; Extensively modified by Luke Lee in 2013 to support complete C expression
-;; evaluation and argumented macro expansion.
+;; evaluation and argumented macro expansion; C++11, C++14, C++17, GCC
+;; extension literals and gcc/clang matching behaviours are supported in 2021.
+;; Various floating point types and operations are also supported but the
+;; actual precision is limited by the Emacs internal floating representation,
+;; which is the C data type "double" or IEEE binary64 format.
;;; Code:
@@ -136,7 +149,7 @@
:type '(choice (const nil) string)
:version "25.1")
-(defcustom hide-ifdef-expand-reinclusion-protection t
+(defcustom hide-ifdef-expand-reinclusion-guard t
"Non-nil means don't hide an entire header file enclosed by #ifndef...#endif.
Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion:
@@ -161,7 +174,7 @@ outermost #if is always visible."
(defcustom hide-ifdef-header-regexp
"\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'"
"C/C++ header file name patterns to determine if current buffer is a header.
-Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
+Effective only if `hide-ifdef-expand-reinclusion-guard' is t."
:type 'regexp
:version "25.1")
@@ -195,6 +208,21 @@ Effective only if
`hide-ifdef-expand-reinclusion-protection' is t."
:type 'key-sequence
:version "27.1")
+(defcustom hide-ifdef-verbose nil
+ "Show some defining symbols on hiding for a visible feedback."
+ :type 'boolean
+ :version "27.2")
+
+(defcustom hide-ifdef-evalulate-enter-hook nil
+ "Hook function to be called when entering `hif-evaluate-macro'."
+ :type 'hook
+ :version "27.2")
+
+(defcustom hide-ifdef-evalulate-leave-hook nil
+ "Hook function to be called when leaving `hif-evaluate-macro'."
+ :type 'hook
+ :version "27.2")
+
(defvar hide-ifdef-mode-map
;; Set up the mode's main map, which leads via the prefix key to the submap.
(let ((map (make-sparse-keymap)))
@@ -306,9 +334,9 @@ Several variables affect how the hiding is done:
;; (default-value 'hide-ifdef-env))
(setq hide-ifdef-env (default-value 'hide-ifdef-env))
;; Some C/C++ headers might have other ways to prevent reinclusion and
- ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be
nil.
- (setq-local hide-ifdef-expand-reinclusion-protection
- (default-value 'hide-ifdef-expand-reinclusion-protection))
+ ;; thus would like `hide-ifdef-expand-reinclusion-guard' to be nil.
+ (setq-local hide-ifdef-expand-reinclusion-guard
+ (default-value 'hide-ifdef-expand-reinclusion-guard))
(setq-local hide-ifdef-hiding
(default-value 'hide-ifdef-hiding))
(setq-local hif-outside-read-only buffer-read-only)
@@ -330,23 +358,42 @@ Several variables affect how the hiding is done:
(defun hif-clear-all-ifdef-defined ()
"Clears all symbols defined in `hide-ifdef-env'.
It will backup this variable to `hide-ifdef-env-backup' before clearing to
-prevent accidental clearance."
- (interactive)
- (when (y-or-n-p "Clear all #defined symbols? ")
- (setq hide-ifdef-env-backup hide-ifdef-env)
- (setq hide-ifdef-env nil)))
-
-(defun hif-show-all ()
- "Show all of the text in the current buffer."
+prevent accidental clearance.
+When prefixed, it swaps current symbols with the backup ones."
(interactive)
- (hif-show-ifdef-region (point-min) (point-max)))
+ (if current-prefix-arg
+ (if hide-ifdef-env-backup
+ (when (y-or-n-p (format
+ "Restore all %d #defined symbols just cleared? "
+ (length hide-ifdef-env-backup)))
+ (let ((tmp hide-ifdef-env-backup))
+ (setq hide-ifdef-env hide-ifdef-env-backup)
+ (setq hide-ifdef-env-backup tmp))
+ (message "Backup symbols restored."))
+ (message "No backup symbol to restore."))
+ (when (y-or-n-p (format "Clear all %d #defined symbols? "
+ (length hide-ifdef-env)))
+ (if hide-ifdef-env ;; backup only if not empty
+ (setq hide-ifdef-env-backup hide-ifdef-env))
+ (setq hide-ifdef-env nil)
+ (message "All defined symbols cleared." ))))
+
+(defun hif-show-all (&optional start end)
+ "Show all of the text in the current buffer.
+If there is a marked region from START to END it only shows the symbols
within."
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
+ (hif-show-ifdef-region
+ (or start (point-min)) (or end (point-max))))
;; By putting this on after-revert-hook, we arrange that it only
;; does anything when revert-buffer avoids turning off the mode.
;; (That can happen in VC.)
(defun hif-after-revert-function ()
(and hide-ifdef-mode hide-ifdef-hiding
- (hide-ifdefs t)))
+ (hide-ifdefs nil nil t)))
(add-hook 'after-revert-hook 'hif-after-revert-function)
(defun hif-end-of-line ()
@@ -427,9 +474,17 @@ Everything including these lines is made invisible."
;;===%%SF%% evaluation (Start) ===
+(defun hif-eval (form)
+ "Evaluate hideif internal representation."
+ (let ((val (eval form)))
+ (if (stringp val)
+ (or (get-text-property 0 'hif-value val)
+ val)
+ val)))
+
;; It is not useful to set this to anything but `eval'.
;; In fact, the variable might as well be eliminated.
-(defvar hide-ifdef-evaluator 'eval
+(defvar hide-ifdef-evaluator #'hif-eval
"The function to use to evaluate a form.
The evaluator is given a canonical form and returns t if text under
that form should be displayed.")
@@ -442,23 +497,42 @@ that form should be displayed.")
"Prepend (VAR VALUE) pair to `hide-ifdef-env'."
(setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
+(defconst hif-predefine-alist
+ '((__LINE__ . hif-__LINE__)
+ (__FILE__ . hif-__FILE__)
+ (__COUNTER__ . hif-__COUNTER__)
+ (__cplusplus . hif-__cplusplus)
+ (__DATE__ . hif-__DATE__)
+ (__TIME__ . hif-__TIME__)
+ (__STDC__ . hif-__STDC__)
+ (__STDC_VERSION__ . hif-__STDC_VERSION__)
+ (__STDC_HOST__ . hif-__STDC_HOST__)
+ (__BASE_FILE__ . hif-__FILE__)))
+
(declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var))
(declare-function semantic-c-hideif-defined "semantic/bovine/c" (var))
(defun hif-lookup (var)
(or (when (bound-and-true-p semantic-c-takeover-hideif)
(semantic-c-hideif-lookup var))
- (let ((val (assoc var hide-ifdef-env)))
+ (let ((val (assq var hide-ifdef-env)))
(if val
(cdr val)
- hif-undefined-symbol))))
+ (if (setq val (assq var hif-predefine-alist))
+ (funcall (cdr val))
+ hif-undefined-symbol)))))
(defun hif-defined (var)
- (cond
- ((bound-and-true-p semantic-c-takeover-hideif)
- (semantic-c-hideif-defined var))
- ((assoc var hide-ifdef-env) 1)
- (t 0)))
+ (let (def)
+ (cond
+ ((bound-and-true-p semantic-c-takeover-hideif)
+ (semantic-c-hideif-defined var))
+ ;; Here we can't use hif-lookup as an empty definition like `#define
EMPTY'
+ ;; is considered defined but is evaluated as `nil'.
+ ((assq var hide-ifdef-env) 1)
+ ((and (setq def (assq var hif-predefine-alist))
+ (funcall (cdr def))) 1)
+ (t 0))))
;;===%%SF%% evaluation (End) ===
@@ -484,7 +558,7 @@ that form should be displayed.")
(defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)"))
(defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*"))
(defconst hif-macroref-regexp
- (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp
+ (concat hif-white-regexp "\\(" hif-id-regexp "\\)"
"\\("
"(" hif-white-regexp
"\\(" hif-id-regexp "\\)?" hif-white-regexp
@@ -493,6 +567,75 @@ that form should be displayed.")
")"
"\\)?" ))
+;; The point here is *NOT* to do "syntax error checking" for C(++) compiler,
but
+;; to parse and recognize *already valid* numeric literals. Therefore we don't
+;; need to worry if number like "0x12'" is invalid, leave it to the compiler.
+;; Otherwise, the runtime performance of hideif would be poor.
+;;
+;; GCC fixed-point literal extension:
+;;
+;; ‘ullk’ or ‘ULLK’ for unsigned long long _Accum and _Sat unsigned long long
_Accum
+;; ‘ullr’ or ‘ULLR’ for unsigned long long _Fract and _Sat unsigned long long
_Fract
+;;
+;; ‘llk’ or ‘LLK’ for long long _Accum and _Sat long long _Accum
+;; ‘llr’ or ‘LLR’ for long long _Fract and _Sat long long _Fract
+;; ‘uhk’ or ‘UHK’ for unsigned short _Accum and _Sat unsigned short _Accum
+;; ‘ulk’ or ‘ULK’ for unsigned long _Accum and _Sat unsigned long _Accum
+;; ‘uhr’ or ‘UHR’ for unsigned short _Fract and _Sat unsigned short _Fract
+;; ‘ulr’ or ‘ULR’ for unsigned long _Fract and _Sat unsigned long _Fract
+;;
+;; ‘lk’ or ‘LK’ for long _Accum and _Sat long _Accum
+;; ‘lr’ or ‘LR’ for long _Fract and _Sat long _Fract
+;; ‘uk’ or ‘UK’ for unsigned _Accum and _Sat unsigned _Accum
+;; ‘ur’ or ‘UR’ for unsigned _Fract and _Sat unsigned _Fract
+;; ‘hk’ or ‘HK’ for short _Accum and _Sat short _Accum
+;; ‘hr’ or ‘HR’ for short _Fract and _Sat short _Fract
+;;
+;; ‘r’ or ‘R’ for _Fract and _Sat _Fract
+;; ‘k’ or ‘K’ for _Accum and _Sat _Accum
+
+;; C++14 also include '0b' for binary and "'" as separator
+(defconst hif-numtype-suffix-regexp
+ ;;
"\\(ll[uU]\\|LL[uU]\\|[uU]?ll\\|[uU]?LL\\|[lL][uU]\\|[uU][lL]\\|[uUlLfF]\\)"
+ (concat
+ "\\(\\(ll[uU]\\|LL[uU]\\|[uU]?ll\\|[uU]?LL\\|[lL][uU]\\|[uU][lL]\\|"
+ "[uU][hH]\\)[kKrR]?\\|" ; GCC fixed-point extension
+ "[dD][dDfFlL]\\|" ; GCC floating-point extension
+ "[uUlLfF]\\)"))
+(defconst hif-bin-regexp
+ (concat "[+-]?0[bB]\\([01']+\\)"
+ hif-numtype-suffix-regexp "?"))
+(defconst hif-hex-regexp
+ (concat "[+-]?0[xX]\\([[:xdigit:]']+\\)"
+ hif-numtype-suffix-regexp "?"))
+(defconst hif-oct-regexp
+ (concat "[+-]?0[0-7']+"
+ hif-numtype-suffix-regexp "?"))
+(defconst hif-dec-regexp
+ (concat "[+-]?\\(0\\|[1-9][0-9']*\\)"
+ hif-numtype-suffix-regexp "?"))
+
+(defconst hif-decfloat-regexp
+ ;; `hif-string-to-decfloat' relies on the number and ordering of parentheses
+ (concat
+ "\\(?:"
+ "\\([+-]?[0-9]+\\)\\([eE][+-]?[0-9]+\\)?[dD]?[fFlL]?"
+ "\\|\\([+-]?[0-9]+\\)\\.\\([eE][+-]?[0-9]+\\)?[dD]?[dDfFlL]?"
+ "\\|\\([+-]?[0-9]*\\.[0-9]+\\)\\([eE][+-]?[0-9]+\\)?[dD]?[dDfFlL]?"
+ "\\)"))
+
+;; C++17 hexadecimal floating point literal
+(defconst hif-hexfloat-regexp
+ ;; `hif-string-to-hexfloat' relies on the ordering of regexp groupings
+ (concat
+ "[+-]?\\(?:"
+ "0[xX]\\([[:xdigit:]']+\\)[pP]\\([+-]?[0-9']+\\)[fFlL]?"
+ "\\|"
+ "0[xX]\\([[:xdigit:]']+\\)\\.[pP]\\([+-]?[0-9']+\\)[fFlL]?"
+ "\\|"
+
"0[xX]\\([[:xdigit:]']*\\)\\.\\([[:xdigit:]']+\\)[pP]\\([+-]?[0-9']+\\)[fFlL]?"
+ "\\)"))
+
;; Store the current token and the whole token list during parsing.
;; Bound dynamically.
(defvar hif-token)
@@ -530,29 +673,113 @@ that form should be displayed.")
(":" . hif-colon)
("," . hif-comma)
("#" . hif-stringify)
- ("..." . hif-etc)))
+ ("..." . hif-etc)
+ ("defined" . hif-defined)))
(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
(defconst hif-token-regexp
- (concat (regexp-opt (mapcar 'car hif-token-alist))
- "\\|0x[[:xdigit:]]+\\.?[[:xdigit:]]*"
- "\\|[0-9]+\\.?[0-9]*" ;; decimal/octal
- "\\|\\w+"))
-
-(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")
+ ;; The ordering of regexp grouping is crutial to `hif-strtok'
+ (concat
+ ;; hex/binary:
+
"\\([+-]?0[xXbB]\\([[:xdigit:]']+\\)?\\.?\\([[:xdigit:]']+\\)?\\([pP]\\([+-]?[0-9]+\\)\\)?"
+ hif-numtype-suffix-regexp "?\\)"
+ ;; decimal/octal:
+ "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?"
+ hif-numtype-suffix-regexp "?\\)"
+ "\\|" (regexp-opt (mapcar 'car hif-token-alist) t)
+ "\\|\\(\\w+\\)"))
+
+;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"")
+(defconst hif-unicode-prefix-regexp "\\(?:u8R?\\|[uUL]R?\\\|R\\)")
+(defconst hif-string-literal-regexp
+ (concat hif-unicode-prefix-regexp "?"
+ "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)"))
+
+;; matching and conversion
+
+(defun hif-full-match (regexp string)
+ "A full REGEXP match of STRING instead of partially match."
+ (string-match (concat "\\`" regexp "\\'") string))
+
+(defun hif-is-number (string)
+ "Check if STRING is a valid C(++) numeric literal."
+ (or (hif-full-match hif-dec-regexp string)
+ (hif-full-match hif-hex-regexp string)
+ (hif-full-match hif-oct-regexp string)
+ (hif-full-match hif-bin-regexp string)))
+
+(defun hif-is-float (string)
+ "Check if STRING is a valid C(++) floating point literal."
+ (or (hif-full-match hif-decfloat-regexp string)
+ (hif-full-match hif-hexfloat-regexp string)))
+
+(defun hif-delete-char-in-string (char string)
+ "Delete CHAR in STRING inplace."
+ (let ((i (length string))
+ (s nil))
+ (while (> i 0)
+ (setq i (1- i))
+ (unless (eq (aref string i) char)
+ (setq s (cons (aref string i) s))))
+ (concat s)))
+
+(defun hif-string-to-decfloat (string &optional fix exp)
+ "Convert a C(++) decimal floating formatted string into float.
+Assuming we've just regexp-matched with `hif-decfloat-regexp' and it matched.
+if REMATCH is t, do a rematch."
+ ;; In elisp `(string-to-number "01.e2")' will return 1 instead of the
expected
+ ;; 100.0; therefore we need to write our own.
+ ;; This function relies on the regexp groups of `hif-dexfloat-regexp'
+ (if (or fix exp)
+ (setq fix (hif-delete-char-in-string ?' fix)
+ exp (hif-delete-char-in-string ?' exp))
+ ;; rematch
+ (setq string (hif-delete-char-in-string ?' string))
+ (hif-full-match hif-decfloat-regexp string)
+ (setq fix (or (match-string 1 string)
+ (match-string 3 string)
+ (match-string 5 string))
+ exp (or (match-string 2 string)
+ (match-string 4 string)
+ (match-string 6 string))))
+ (setq fix (string-to-number fix)
+ exp (if (zerop (length exp)) ;; nil or ""
+ 0 (string-to-number (substring-no-properties exp 1))))
+ (* fix (expt 10 exp)))
+
+(defun hif-string-to-hexfloat (string &optional int fra exp)
+ "Convert a C++17 hex float formatted string into float.
+Assuming we've just regexp-matched with `hif-hexfloat-regexp' and it matched.
+if REMATCH is t, do a rematch."
+ ;; This function relies on the regexp groups of `hif-hexfloat-regexp'
+ (let ((negate (if (eq ?- (aref string 0)) -1.0 1.0)))
+ (if (or int fra exp)
+ (setq int (hif-delete-char-in-string ?' int)
+ fra (hif-delete-char-in-string ?' fra)
+ exp (hif-delete-char-in-string ?' exp))
+ (setq string (hif-delete-char-in-string ?' string))
+ (hif-full-match hif-hexfloat-regexp string)
+ (setq int (or (match-string 1 string)
+ (match-string 3 string)
+ (match-string 5 string))
+ fra (or (match-string 2 string)
+ (match-string 4 string)
+ (match-string 6 string))
+ exp (match-string 7 string)))
+ (setq int (if (zerop (length int)) ;; nil or ""
+ 0 (string-to-number int 16))
+ fra (if (zerop (length fra))
+ 0 (/ (string-to-number fra 16)
+ (expt 16.0 (length fra))))
+ exp (if (zerop (length exp))
+ 0 (string-to-number exp)))
+ (* negate (+ int fra) (expt 2.0 exp))))
(defun hif-string-to-number (string &optional base)
- "Like `string-to-number', but it understands non-decimal floats."
- (if (or (not base) (= base 10))
- (string-to-number string base)
- (let* ((parts (split-string string "\\." t "[ \t]+"))
- (frac (cadr parts))
- (fraclen (length frac))
- (quot (expt (if (zerop fraclen)
- base
- (* base 1.0)) fraclen)))
- (/ (string-to-number (concat (car parts) frac) base) quot))))
+ "Like `string-to-number', but it understands C(++) literals."
+ (setq string (hif-delete-char-in-string ?' string))
+ (string-to-number string base))
;; The dynamic binding variable `hif-simple-token-only' is shared only by
;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent
`hif-tokenize'
@@ -562,52 +789,204 @@ that form should be displayed.")
;; Check the long comments before `hif-find-define' for more details. [lukelee]
(defvar hif-simple-token-only)
+(defsubst hif-is-white (c)
+ (memq c '(? ?\t ?\n ?\r)))
+
+(defun hif-strtok (string &optional rematch)
+ "Convert STRING into a hideif mode internal token.
+Assuming we've just performed a `hif-token-regexp' lookup."
+ ;; This function relies on the regexp groups of `hif-token-regexp'
+ ;; New hideif internal number representation: a text string with `hif-value'
+ ;; property to keep its value. Strings without `hif-value' property is a
+ ;; normal C(++) string. This is mainly for stringification. The original
+ ;; implementation only keep the value thus a C++ number like octal 01234
+ ;; will become "668" after being stringified instead of the expected "01234".
+ (let (bufstr m1 m3 m5 m6 m8 neg ch val dec)
+ (when rematch
+ (string-match hif-token-regexp string)
+ (setq bufstr string))
+
+ (cond
+
+ ;; decimal/octal
+ ((match-string 8 bufstr)
+ (setq m6 (match-string 9 bufstr))
+ (setq val
+ (if (or (setq m8 (match-string 11 bufstr))
+ (match-string 10 bufstr)) ;; floating
+ ;; TODO: do we need to add 'hif-type property for
+ ;; type-checking, but this will slow things down
+ (hif-string-to-decfloat string m6 m8)
+ (setq ch (aref string 0))
+ (hif-string-to-number
+ string
+ ;; octal begin with `0'
+ (if (and (> (length string) 1)
+ (or (eq ch ?0)
+ ;; -0... or +0...
+ (and (memq ch '(?- ?+))
+ (eq (aref string 1) ?0))))
+ 8 (setq dec 10)))))
+ ;; Decimal integer without sign and extension is identical to its
+ ;; string form, make it as simple as possible
+ (if (and dec
+ (null (match-string 12 bufstr)) ;; no extension like 'UL'
+ (not (memq ch '(?- ?+))))
+ val
+ (add-text-properties 0 1 (list 'hif-value val) string)
+ string))
+
+ ;; hex/binary
+ ((match-string 1 bufstr)
+ (setq m3 (match-string 3 bufstr))
+ (add-text-properties
+ 0 1
+ (list 'hif-value
+ (if (or (setq m5 (match-string 5 bufstr))
+ m3)
+ (hif-string-to-hexfloat
+ string
+ (match-string 2 bufstr) m3 m5) ;; hexfloat
+ (setq neg (if (eq (aref string 0) ?-) -1 1))
+ (* neg
+ (hif-string-to-number
+ ;; (5-(-1))/2=3; (5-1)/2=2
+ (substring-no-properties string (ash (- 5 neg) -1))
+ ;; (3-(-1))/2=2; (3-1)/2=1
+ (if (or (eq (setq ch (aref string (ash (- 3 neg) -1))) ?x)
+ (eq ch ?X)) ;; hex
+ 16 2)))))
+ string) string)
+
+ ;; operator
+ ((setq m1 (match-string 14 bufstr))
+ (cdr (assoc m1 hif-token-alist #'string-equal)))
+
+ (t
+ (setq hif-simple-token-only nil)
+ (intern-safe string)))))
+
+(defun hif-backward-comment (&optional start end)
+ "If we're currently within a C(++) comment, skip them backwards."
+ ;; Ignore trailing white spaces after comment
+ (setq end (or end (point)))
+ (while (and (> (1- end) 1)
+ (hif-is-white (char-after (1- end))))
+ (cl-decf end))
+ (let ((p0 end)
+ p cmt ce ws we ;; ce:comment start, ws:white start, we whilte end
+ cmtlist) ;; pair of (start.end) of comments
+ (setq start (or start (progn (beginning-of-line) (point)))
+ p start)
+ (while (< (1+ p) end)
+ (if (char-equal ?/ (char-after p)) ; /
+ (if (char-equal ?/ (char-after (1+ p))) ; //
+ (progn
+ ;; merge whites immediately ahead
+ (setq ce (if (and we (= (1- p) we)) ws p))
+ ;; scan for end of line
+ (while (and (< (cl-incf p) end)
+ (not (char-equal ?\n (char-after p)))
+ (not (char-equal ?\r (char-after p)))))
+ ;; Merge with previous comment if immediately followed
+ (push (cons (if (and cmtlist
+ (= (cdr (car cmtlist)) ce))
+ (car (pop cmtlist)) ;; extend previous comment
+ ce)
+ p)
+ cmtlist))
+ (when (char-equal ?* (char-after (1+ p))) ; /*
+ ;; merge whites immediately ahead
+ (setq ce (if (and we (= (1- p) we)) ws p))
+ ;; Check if it immediately follows previous /*...*/ comment;
+ ;; if yes, extend and merge into previous comment
+ (setq cmt (if (and cmtlist
+ (= (cdr (car cmtlist)) ce))
+ (car (pop cmtlist)) ;; extend previous comment
+ ce))
+ (setq p (+ 2 p))
+ ;; Scanning for `*/'
+ (catch 'break
+ (while (< (1+ p) end)
+ (if (not (and (char-equal ?* (char-after p))
+ (char-equal ?/ (char-after (1+ p)))))
+ (cl-incf p)
+ ;; found `*/', mark end pos
+ (push (cons cmt (1+ (setq p (1+ p)))) cmtlist)
+ (throw 'break nil)))
+ ;; (1+ p) >= end
+ (push (cons cmt end) cmtlist))))
+ ;; Trace most recent continuous white spaces before a comment
+ (if (char-equal ? (char-after p))
+ (if (and ws (= we (1- p))) ;; continued
+ (setq we p)
+ (setq ws p
+ we p))
+ (setq ws nil
+ we nil)))
+ (cl-incf p))
+ ;; Goto beginning of the last comment, if we're within
+ (setq cmt (car cmtlist)) ;; last cmt
+ (setq cmt (if (and cmt
+ (>= p0 (car cmt))
+ (<= p0 (cdr cmt)))
+ (car cmt) ;; beginning of the last comment
+ p0))
+ ;; Ignore leading whites ahead of comment
+ (while (and (> (1- cmt) 1)
+ (hif-is-white (char-after (1- cmt))))
+ (cl-decf cmt))
+ (goto-char cmt)))
+
(defun hif-tokenize (start end)
"Separate string between START and END into a list of tokens."
- (let ((token-list nil))
+ (let ((token-list nil)
+ (white-regexp "[ \t]+")
+ token)
(setq hif-simple-token-only t)
(with-syntax-table hide-ifdef-syntax-table
(save-excursion
- (goto-char start)
- (while (progn (forward-comment (point-max)) (< (point) end))
- ;; (message "expr-start = %d" expr-start) (sit-for 1)
- (cond
- ((looking-at "\\\\\n")
- (forward-char 2))
-
- ((looking-at hif-string-literal-regexp)
- (push (substring-no-properties (match-string 1)) token-list)
- (goto-char (match-end 0)))
-
- ((looking-at hif-token-regexp)
- (let ((token (buffer-substring-no-properties
- (point) (match-end 0))))
+ (save-restriction
+ ;; Narrow down to the focusing region so that the ending white spaces
+ ;; of that line will not be treated as a white, as `looking-at' won't
+ ;; look outside the restriction; otherwise it will note the last
token
+ ;; or string as one with an `hif-space' property.
+ (setq end (hif-backward-comment start end))
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (progn (forward-comment (point-max)) (< (point) end))
+ ;; (message "expr-start = %d" expr-start) (sit-for 1)
+ (cond
+ ((looking-at "\\\\\n")
+ (forward-char 2))
+
+ ((looking-at hif-string-literal-regexp)
+ (setq token (substring-no-properties (match-string 1)))
+ (goto-char (match-end 0))
+ (when (looking-at white-regexp)
+ (add-text-properties 0 1 '(hif-space t) token)
+ (goto-char (match-end 0)))
+ (push token token-list))
+
+ ((looking-at hif-token-regexp)
(goto-char (match-end 0))
- ;; (message "token: %s" token) (sit-for 1)
- (push
- (or (cdr (assoc token hif-token-alist))
- (if (string-equal token "defined") 'hif-defined)
- ;; TODO:
- ;; 1. postfix 'l', 'll', 'ul' and 'ull'
- ;; 2. floating number formats (like 1.23e4)
- ;; 3. 098 is interpreted as octal conversion error
- (if (string-match "0x\\([[:xdigit:]]+\\.?[[:xdigit:]]*\\)"
- token)
- (hif-string-to-number (match-string 1 token) 16)) ;; hex
- (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token)
- (hif-string-to-number token 8)) ;; octal
- (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'"
- token)
- (string-to-number token)) ;; decimal
- (prog1 (intern token)
- (setq hif-simple-token-only nil)))
- token-list)))
-
- ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
- (forward-char 1)) ; the source code. Let's not get stuck here.
- (t (error "Bad #if expression: %s" (buffer-string)))))))
-
- (nreverse token-list)))
+ (setq token (hif-strtok
+ (substring-no-properties (match-string 0))))
+ (push token token-list)
+ (when (looking-at white-regexp)
+ ;; We can't just append a space to the token string, otherwise
+ ;; `0xf0 ' ## `01' will become `0xf0 01' instead of the
expected
+ ;; `0xf001', hence a standalone `hif-space' is placed instead.
+ (push 'hif-space token-list)
+ (goto-char (match-end 0))))
+
+ ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
+ (forward-char 1)) ; the source code. Let's not get stuck here.
+
+ (t (error "Bad #if expression: %s" (buffer-string)))))))
+ (if (eq 'hif-space (car token-list))
+ (setq token-list (cdr token-list))) ;; remove trailing white space
+ (nreverse token-list))))
;;------------------------------------------------------------------------
;; Translate C preprocessor #if expressions using recursive descent.
@@ -637,50 +1016,96 @@ that form should be displayed.")
;; | | ^= = | |
;; | Comma | , | left-to-right |
-(defsubst hif-nexttoken ()
+(defun hif-nexttoken (&optional keep-space)
"Pop the next token from token-list into the let variable `hif-token'."
- (setq hif-token (pop hif-token-list)))
+ (let ((prevtoken hif-token))
+ (while (progn
+ (setq hif-token (pop hif-token-list))
+ (if keep-space ; keep only one space
+ (and (eq prevtoken 'hif-space)
+ (eq hif-token 'hif-space))
+ (eq hif-token 'hif-space)))))
+ hif-token)
+
+(defun hif-split-signed-token ()
+ "Split current numeric token into two (hif-plus/minus num)."
+ (let* (val ch0 head)
+ (when (and (stringp hif-token)
+ (setq val (get-text-property 0 'hif-value hif-token))
+ ;; explicitly signed?
+ (memq (setq ch0 (aref hif-token 0)) '(?+ ?-)))
+ (if (eq ch0 ?+)
+ (setq head 'hif-plus)
+ (setq head 'hif-minus
+ val (- val)))
+ (setq hif-token (substring hif-token 1))
+ (add-text-properties 0 1 (list 'hif-value val) hif-token)
+ (push hif-token hif-token-list)
+ (setq hif-token head))))
(defsubst hif-if-valid-identifier-p (id)
(not (or (numberp id)
- (stringp id))))
+ (stringp id)
+ (and (atom id)
+ (eq 'defined id)))))
(defun hif-define-operator (tokens)
"\"Upgrade\" hif-define XXX to `(hif-define XXX)' so it won't be
substituted."
- (let ((result nil)
- (tok nil))
- (while (setq tok (pop tokens))
- (push
- (if (eq tok 'hif-defined)
- (progn
- (setq tok (cadr tokens))
- (if (eq (car tokens) 'hif-lparen)
- (if (and (hif-if-valid-identifier-p tok)
- (eq (nth 2 tokens) 'hif-rparen))
- (setq tokens (cl-cdddr tokens))
- (error "#define followed by non-identifier: %S" tok))
- (setq tok (car tokens)
- tokens (cdr tokens))
- (unless (hif-if-valid-identifier-p tok)
- (error "#define followed by non-identifier: %S" tok)))
- (list 'hif-defined 'hif-lparen tok 'hif-rparen))
- tok)
- result))
- (nreverse result)))
+ (if (memq 'hif-defined tokens)
+ (let* ((hif-token-list tokens)
+ hif-token
+ target
+ paren)
+ (setq tokens nil) ;; now it becomes the result
+ (while (hif-nexttoken t) ;; keep `hif-space'
+ (when (eq hif-token 'hif-defined)
+ ;; defined XXX, start ignoring `hif-space'
+ (hif-nexttoken)
+ (if (setq paren (eq hif-token 'hif-lparen))
+ (hif-nexttoken))
+ (if (not (hif-if-valid-identifier-p
+ (setq target hif-token)))
+ (error "`defined' followed by non-identifier: %S" target))
+ (if (and paren
+ (not (eq (hif-nexttoken) 'hif-rparen)))
+ (error "missing right parenthesis for `defined'"))
+ (setq hif-token
+ (list 'hif-defined 'hif-lparen target 'hif-rparen)))
+ (push hif-token tokens))
+ (nreverse tokens))
+ tokens))
(define-obsolete-function-alias 'hif-flatten #'flatten-tree "27.1")
-(defun hif-expand-token-list (tokens &optional macroname expand_list)
+(defun hif-keep-single (l e)
+ "Prevent two or more consecutive E in list L."
+ (if (memq e l)
+ (let (prev curr result)
+ (while (progn
+ (setq prev curr
+ curr (car l)
+ l (cdr l))
+ curr)
+ (unless (and (eq prev e)
+ (eq curr e))
+ (push curr result)))
+ (nreverse result))
+ l))
+
+(defun hif-expand-token-list (tokens &optional macroname expand_list level)
"Perform expansion on TOKENS till everything expanded.
Self-reference (directly or indirectly) tokens are not expanded.
EXPAND_LIST is the list of macro names currently being expanded, used for
-detecting self-reference."
+detecting self-reference.
+Function-like macros with calling depth LEVEL 0 does not expand arguments,
+this is to emulate the stringification behavior of C++ preprocessor."
(catch 'self-referencing
(let ((expanded nil)
(remains (hif-define-operator
(hif-token-concatenation
(hif-token-stringification tokens))))
tok rep)
+ (setq level (if level level 0))
(if macroname
(setq expand_list (cons macroname expand_list)))
;; Expanding all tokens till list exhausted
@@ -699,21 +1124,31 @@ detecting self-reference."
(if (and (listp rep)
(eq (car rep) 'hif-define-macro)) ; A defined macro
;; Recursively expand it
+ ;; only in defined macro do we increase the nesting LEVEL
(if (cadr rep) ; Argument list is not nil
- (if (not (eq (car remains) 'hif-lparen))
+ (if (not (or (eq (car remains) 'hif-lparen)
+ ;; hif-space hif-lparen
+ (and (eq (car remains) 'hif-space)
+ (eq (cadr remains) 'hif-lparen)
+ (setq remains (cdr remains)))))
;; No argument, no invocation
tok
;; Argumented macro, get arguments and invoke it.
- ;; Dynamically bind hif-token-list and hif-token
- ;; for hif-macro-supply-arguments
+ ;; Dynamically bind `hif-token-list' and `hif-token'
+ ;; for `hif-macro-supply-arguments'
(let* ((hif-token-list (cdr remains))
(hif-token nil)
- (parmlist (mapcar #'hif-expand-token-list
- (hif-get-argument-list)))
+ (parmlist
+ (if (zerop level)
+ (hif-get-argument-list t)
+ (mapcar (lambda (a)
+ (hif-expand-token-list
+ a nil nil (1+ level)))
+ (hif-get-argument-list t))))
(result
(hif-expand-token-list
(hif-macro-supply-arguments tok parmlist)
- tok expand_list)))
+ tok expand_list (1+ level))))
(setq remains (cons hif-token hif-token-list))
result))
;; Argument list is nil, direct expansion
@@ -745,16 +1180,20 @@ detecting self-reference."
"Parse the TOKEN-LIST.
Return translated list in prefix form. MACRONAME is applied when invoking
macros to prevent self-reference."
- (let ((hif-token-list (hif-expand-token-list token-list macroname)))
+ (let ((hif-token-list (hif-expand-token-list token-list macroname nil))
+ (hif-token nil))
(hif-nexttoken)
(prog1
(and hif-token
(hif-exprlist))
(if hif-token ; is there still a token?
- (error "Error: unexpected token: %s" hif-token)))))
+ (error "Error: unexpected token at line %d: `%s'"
+ (line-number-at-pos)
+ (or (car (rassq hif-token hif-token-alist))
+ hif-token))))))
(defun hif-exprlist ()
- "Parse an exprlist: expr { `,' expr}."
+ "Parse an exprlist: expr { `,' expr }."
(let ((result (hif-expr)))
(if (eq hif-token 'hif-comma)
(let ((temp (list result)))
@@ -824,7 +1263,7 @@ expr : or-expr | or-expr `?' expr `:' expr."
(defun hif-eq-expr ()
"Parse an eq-expr : comp | eq-expr `=='|`!=' comp."
(let ((result (hif-comp-expr))
- (eq-token nil))
+ (eq-token nil))
(while (memq hif-token '(hif-equal hif-notequal))
(setq eq-token hif-token)
(hif-nexttoken)
@@ -857,7 +1296,9 @@ expr : or-expr | or-expr `?' expr `:' expr."
math : muldiv | math `+'|`-' muldiv."
(let ((result (hif-muldiv-expr))
(math-op nil))
- (while (memq hif-token '(hif-plus hif-minus))
+ (while (or (memq hif-token '(hif-plus hif-minus))
+ ;; One token lookahead
+ (hif-split-signed-token))
(setq math-op hif-token)
(hif-nexttoken)
(setq result (list math-op result (hif-muldiv-expr))))
@@ -876,7 +1317,7 @@ expr : or-expr | or-expr `?' expr `:' expr."
(defun hif-factor ()
"Parse a factor.
-factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' |
+factor : `!' factor | `~' factor | `(' exprlist `)' | `defined(' id `)' |
id `(' parmlist `)' | strings | id."
(cond
((eq hif-token 'hif-not)
@@ -908,10 +1349,14 @@ factor : `!' factor | `~' factor | `(' expr `)' |
`defined(' id `)' |
(hif-nexttoken)
`(hif-defined (quote ,ident))))
+ ((stringp hif-token)
+ (if (get-text-property 0 'hif-value hif-token)
+ ;; new hideif internal number format for string concatenation
+ (prog1 hif-token (hif-nexttoken))
+ (hif-string-concatenation)))
+
((numberp hif-token)
(prog1 hif-token (hif-nexttoken)))
- ((stringp hif-token)
- (hif-string-concatenation))
;; Unary plus/minus.
((memq hif-token '(hif-minus hif-plus))
@@ -924,12 +1369,12 @@ factor : `!' factor | `~' factor | `(' expr `)' |
`defined(' id `)' |
(hif-place-macro-invocation ident)
`(hif-lookup (quote ,ident)))))))
-(defun hif-get-argument-list ()
+(defun hif-get-argument-list (&optional keep-space)
(let ((nest 0)
(parmlist nil) ; A "token" list of parameters, will later be parsed
(parm nil))
- (while (or (not (eq (hif-nexttoken) 'hif-rparen))
+ (while (or (not (eq (hif-nexttoken keep-space) 'hif-rparen))
(/= nest 0))
(if (eq (car (last parm)) 'hif-comma)
(setq parm nil))
@@ -945,7 +1390,7 @@ factor : `!' factor | `~' factor | `(' expr `)' |
`defined(' id `)' |
(push hif-token parm))
(push (nreverse parm) parmlist) ; Okay even if PARM is nil
- (hif-nexttoken) ; Drop the `hif-rparen', get next token
+ (hif-nexttoken keep-space) ; Drop the `hif-rparen', get next token
(nreverse parmlist)))
(defun hif-place-macro-invocation (ident)
@@ -973,10 +1418,21 @@ This macro cannot be evaluated alone without parameters
input."
(cond
((numberp a)
(number-to-string a))
- ((atom a)
- (symbol-name a))
((stringp a)
- (concat "\"" a "\""))
+ ;; Remove properties here otherwise a string like "0x12 + 0x34" will be
+ ;; later evaluated as (0x12 + 0x34) and become 0x70.
+ ;; See also `hif-eval' and `hif-mathify'.
+ (concat (substring-no-properties a)
+ (if (get-text-property 0 'hif-space a) " ")))
+ ((atom a)
+ (if (memq a hif-valid-token-list)
+ (car (rassq a hif-token-alist))
+ (if (eq a 'hif-space)
+ " "
+ (symbol-name a))))
+ ((listp a) ;; stringify each element then concat
+ (cl-loop for e in a
+ concat (hif-stringify e)))
(t
(error "Invalid token to stringify"))))
@@ -984,32 +1440,34 @@ This macro cannot be evaluated alone without parameters
input."
(if (stringp str)
(intern str)))
-(defun hif-token-concat (a b)
- "Concatenate two tokens into a longer token.
-Currently support only simple token concatenation. Also support weird (but
-valid) token concatenation like `>' ## `>' becomes `>>'. Here we take care
only
-those that can be evaluated during preprocessing time and ignore all those that
-can only be evaluated at C(++) runtime (like `++', `--' and `+='...)."
- (if (or (memq a hif-valid-token-list)
- (memq b hif-valid-token-list))
- (let* ((ra (car (rassq a hif-token-alist)))
- (rb (car (rassq b hif-token-alist)))
- (result (and ra rb
- (cdr (assoc (concat ra rb) hif-token-alist)))))
- (or result
- ;;(error "Invalid token to concatenate")
- (error "Concatenating \"%s\" and \"%s\" does not give a valid \
-preprocessing token"
- (or ra (symbol-name a))
- (or rb (symbol-name b)))))
- (intern-safe (concat (hif-stringify a)
- (hif-stringify b)))))
+(defun hif-token-concat (l)
+ "Concatenate a list of tokens into a longer token.
+Also support weird (but valid) token concatenation like `>' ## `>' becomes
`>>'.
+Here we take care only those that can be evaluated during preprocessing time
and
+ignore all those that can only be evaluated at C(++) runtime (like `++', `--'
+and `+='...)."
+ (let ((str nil))
+ (dolist (i l)
+ ;;(assert (not (eq i 'hif-space)) nil ;; debug
+ ;; "Internal error: should not be concatenating `hif-space'")
+ (setq str
+ (concat str
+ (if (memq i hif-valid-token-list)
+ (car (rassq i hif-token-alist))
+ (hif-stringify i)))))
+ ;; Check if it's a number, if yes, return the number instead of a symbol.
+ ;; 'hif-value and 'hif-space properties are trimmed off by `hif-stringify'
+ (hif-strtok str t)))
(defun hif-mathify (val)
- "Treat VAL as a number: if it's t or nil, use 1 or 0."
- (cond ((eq val t) 1)
- ((null val) 0)
- (t val)))
+ "Treat VAL as a hideif number: if it's t or nil, use 1 or 0."
+ (cond
+ ((stringp val)
+ (or (get-text-property 0 'hif-value val)
+ val))
+ ((eq val t) 1)
+ ((null val) 0)
+ (t val)))
(defun hif-conditional (a b c)
(if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c)))
@@ -1053,49 +1511,108 @@ preprocessing token"
(defalias 'hif-logxor (hif-mathify-binop logxor))
(defalias 'hif-logand (hif-mathify-binop logand))
+(defun hif-__LINE__ ()
+ (line-number-at-pos))
+
+(defun hif-__FILE__ ()
+ (file-name-nondirectory (buffer-file-name)))
+
+(defvar hif-__COUNTER__ 0)
+(defun hif-__COUNTER__ ()
+ (prog1 hif-__COUNTER__ (cl-incf hif-__COUNTER__)))
+
+(defun hif-__cplusplus ()
+ (and (string-match
+ "\\.c\\(c\\|xx\\|pp\\|\\+\\+\\)\\'"
+ (buffer-file-name))
+ (memq major-mode '(c++-mode cc-mode cpp-mode))
+ 201710))
+
+(defun hif-__DATE__ ()
+ (format-time-string "%Y/%m/%d"))
+
+(defun hif-__TIME__ ()
+ (format-time-string "%H:%M:%S"))
+
+(defun hif-__STDC__ () 1)
+(defun hif-__STDC_VERSION__ () 201710)
+(defun hif-__STDC_HOST__ () 1)
(defun hif-comma (&rest expr)
"Evaluate a list of EXPR, return the result of the last item."
(let ((result nil))
- (dolist (e expr)
+ (dolist (e expr result)
(ignore-errors
- (setq result (funcall hide-ifdef-evaluator e))))
- result))
+ (setq result (funcall hide-ifdef-evaluator e))))))
(defun hif-token-stringification (l)
- "Scan token list for `hif-stringify' ('#') token and stringify the next
token."
- (let (result)
- (while l
- (push (if (eq (car l) 'hif-stringify)
- (prog1
- (if (cadr l)
- (hif-stringify (cadr l))
- (error "No token to stringify"))
- (setq l (cdr l)))
- (car l))
- result)
- (setq l (cdr l)))
- (nreverse result)))
+ "Scan token list for `hif-stringify' (`#') token and stringify the next
token."
+ (if (memq 'hif-stringify l)
+ (let (result)
+ (while l
+ (push (if (eq (car l) 'hif-stringify)
+ (prog1
+ (if (cadr l)
+ (hif-stringify (cadr l))
+ (error "No token to stringify"))
+ (setq l (cdr l)))
+ (car l))
+ result)
+ (setq l (cdr l)))
+ (nreverse result))
+ ;; no `#' presents
+ l))
(defun hif-token-concatenation (l)
- "Scan token list for `hif-token-concat' ('##') token and concatenate two
tokens."
- (let ((prev nil)
- result)
- (while l
- (while (eq (car l) 'hif-token-concat)
- (unless prev
- (error "No token before ## to concatenate"))
- (unless (cdr l)
- (error "No token after ## to concatenate"))
- (setq prev (hif-token-concat prev (cadr l)))
- (setq l (cddr l)))
- (if prev
- (setq result (append result (list prev))))
- (setq prev (car l)
- l (cdr l)))
- (if prev
- (append result (list prev))
- result)))
+ "Scan token list for `hif-token-concat' ('##') token and concatenate tokens."
+ (if (memq 'hif-token-concat l)
+ ;; Notice that after some substitutions, there could be more than
+ ;; one `hif-space' in a list.
+ (let ((items nil)
+ (tk nil)
+ (count 0) ; count of `##'
+ result)
+ (setq l (hif-keep-single l 'hif-space))
+ (while (setq tk (car l))
+ (if (not (eq tk 'hif-token-concat))
+ ;; In reverse order so that we don't have to use `last' or
+ ;; `butlast'
+ (progn
+ (push tk result)
+ (setq l (cdr l)))
+ ;; First `##' met, start `##' sequence
+ ;; We only drop `hif-space' when doing token concatenation
+ (setq items nil
+ count 0)
+ (setq tk (pop result))
+ (if (or (null tk)
+ (and (eq tk 'hif-space)
+ (null (setq tk (pop result)))))
+ (error "No token before `##' to concatenate")
+ (push tk items) ; first item, in reverse order
+ (setq tk 'hif-token-concat))
+ (while (eq tk 'hif-token-concat)
+ (cl-incf count)
+ ;; 2+ item
+ (setq l (cdr l)
+ tk (car l))
+ ;; only one 'hif-space could appear here
+ (if (eq tk 'hif-space) ; ignore it
+ (setq l (cdr l)
+ tk (car l)))
+ (if (or (null tk)
+ (eq tk 'hif-token-concat))
+ (error
+ "No token after the %d-th `##' to concatenate at line %d"
+ count (line-number-at-pos))
+ (push tk items)
+ (setq l (cdr l)
+ tk (car l))))
+ ;; `##' sequence ended, concat them, then push into result
+ (push (hif-token-concat (nreverse items)) result)))
+ (nreverse result))
+ ;; no need to reassemble the list if no `##' presents
+ l))
(defun hif-delimit (lis atom)
(nconc (mapcan (lambda (l) (list l atom))
@@ -1105,7 +1622,7 @@ preprocessing token"
;; Perform token replacement:
(defun hif-macro-supply-arguments (macro-name actual-parms)
"Expand a macro call, replace ACTUAL-PARMS in the macro body."
- (let* ((SA (assoc macro-name hide-ifdef-env))
+ (let* ((SA (assq macro-name hide-ifdef-env))
(macro (and SA
(cdr SA)
(eq (cadr SA) 'hif-define-macro)
@@ -1156,11 +1673,14 @@ preprocessing token"
formal macro-body))
(setq actual-parms (cdr actual-parms)))
- ;; Replacement completed, flatten the whole token list
- (setq macro-body (flatten-tree macro-body))
+ ;; Replacement completed, stringifiy and concatenate the token list.
+ ;; Stringification happens must take place before flattening, otherwise
+ ;; only the first token will be stringified.
+ (setq macro-body
+ (flatten-tree (hif-token-stringification macro-body)))
- ;; Stringification and token concatenation happens here
- (hif-token-concatenation (hif-token-stringification macro-body)))))
+ ;; Token concatenation happens here, keep single 'hif-space
+ (hif-keep-single (hif-token-concatenation macro-body) 'hif-space))))
(defun hif-invoke (macro-name actual-parms)
"Invoke a macro by expanding it, reparse macro-body and finally invoke it."
@@ -1432,7 +1952,7 @@ Point is left unchanged."
;; A bit slimy.
(defun hif-hide-line (point)
- "Hide the line containing point.
+ "Hide the line containing POINT.
Does nothing if `hide-ifdef-lines' is nil."
(when hide-ifdef-lines
(save-excursion
@@ -1441,7 +1961,7 @@ Does nothing if `hide-ifdef-lines' is nil."
(line-beginning-position) (progn (hif-end-of-line) (point))))))
-;; Hif-Possibly-Hide
+;; hif-Possibly-Hide
;; There are four cases. The #ifX expression is "taken" if it
;; the hide-ifdef-evaluator returns T. Presumably, this means the code
;; inside the #ifdef would be included when the program was
@@ -1484,7 +2004,7 @@ Does nothing if `hide-ifdef-lines' is nil."
"Called at #ifX expression, this hides those parts that should be hidden.
It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag
indicating that we should expand the #ifdef even if it should be hidden.
-Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
+Refer to `hide-ifdef-expand-reinclusion-guard' for more details."
;; (message "hif-possibly-hide") (sit-for 1)
(let* ((case-fold-search nil)
(test (hif-canonicalize hif-ifx-regexp))
@@ -1564,23 +2084,83 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for
more details."
(result (funcall hide-ifdef-evaluator expr)))
result))
+(defun hif-display-macro (name def &optional result)
+ (if (and def
+ (listp def)
+ (eq (car def) 'hif-define-macro))
+ (let ((cdef (concat "#define " name))
+ (parmlist (cadr def))
+ s)
+ (setq def (caddr def))
+ ;; parmlist
+ (when parmlist
+ (setq cdef (concat cdef "("))
+ (while (car parmlist)
+ (setq cdef (concat cdef (symbol-name (car parmlist))
+ (if (cdr parmlist) ","))
+ parmlist (cdr parmlist)))
+ (setq cdef (concat cdef ")")))
+ (setq cdef (concat cdef " "))
+ ;; body
+ (while def
+ (if (listp def)
+ (setq s (car def)
+ def (cdr def))
+ (setq s def
+ def nil))
+ (setq cdef
+ (concat cdef
+ (cond
+ ;;((setq tok (car (rassoc s hif-token-alist)))
+ ;; (concat tok (if (eq s 'hif-comma) " ")))
+ ((symbolp s)
+ (concat (hif-stringify s)
+ (if (eq s 'hif-comma) " ")))
+ ((stringp s)
+ (hif-stringify s))
+ (t ;; (numberp s)
+ (format "%S" s))))))
+ (if (and result
+ ;; eg: "#define RECURSIVE_SYMBOL RECURSIVE_SYMBOL"
+ (not (and (listp result)
+ (eq (car result) 'hif-define-macro))))
+ (setq cdef (concat cdef
+ (if (integerp result)
+ (format "\n=> %S (%#x)" result result)
+ (format "\n=> %S" result)))))
+ (message "%s" cdef))
+ (message "%S <= `%s'" def name)))
+
(defun hif-evaluate-macro (rstart rend)
"Evaluate the macro expansion result for the active region.
-If no region active, find the current #ifdefs and evaluate the result.
+If no region is currently active, find the current #ifdef/#define and evaluate
+the result; otherwise it looks for current word at point.
Currently it supports only math calculations, strings or argumented macros can
-not be expanded."
+not be expanded.
+This function by default ignores parsing error and return `false' on evaluating
+runtime C(++) statements or tokens that normal C(++) preprocessor can't
perform;
+however, when this command is prefixed, it will display the error instead."
(interactive
- (if (use-region-p)
- (list (region-beginning) (region-end))
- '(nil nil)))
- (let ((case-fold-search nil))
+ (if (not (use-region-p))
+ '(nil nil)
+ (list (region-beginning) (region-end))))
+ (run-hooks 'hide-ifdef-evalulate-enter-hook)
+ (let ((case-fold-search nil)
+ (currpnt (point))
+ bounds)
(save-excursion
(unless (use-region-p)
(setq rstart nil rend nil)
(beginning-of-line)
- (when (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
- (string= "define" (match-string 2)))
- (re-search-forward hif-macroref-regexp nil t)))
+ (if (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
+ (= (line-number-at-pos currpnt) (line-number-at-pos)))
+ (if (string= "define" (match-string 2))
+ (re-search-forward hif-macroref-regexp nil t))
+ (goto-char currpnt)
+ (setq bounds (bounds-of-thing-at-point 'word)
+ ;; TODO: BOUNDS need a C++ syntax word boundary finder
+ rstart (car bounds)
+ rend (cdr bounds))))
(let* ((start (or rstart (point)))
(end (or rend (progn (hif-end-of-line) (point))))
(defined nil)
@@ -1588,34 +2168,61 @@ not be expanded."
(tokens (ignore-errors ; Prevent C statement things like
; 'do { ... } while (0)'
(hif-tokenize start end)))
+ ;; Note that on evaluating we can't simply define the symbol
+ ;; even if we are currently at a #define line, as this #define
+ ;; might actually be wrapped up in a #if 0 block. We can only
+ ;; define that explicitly with `hide-ifdef-define'.
(expr (or (and (<= (length tokens) 1) ; Simple token
- (setq defined (assoc (car tokens) hide-ifdef-env))
+ (setq defined
+ (or (assq (car tokens) hide-ifdef-env)
+ (assq (car tokens) hif-predefine-alist)))
(setq simple (atom (hif-lookup (car tokens))))
(hif-lookup (car tokens)))
(and tokens
- (condition-case nil
+ (condition-case err
(hif-parse-exp tokens)
(error
- nil)))))
- (result (funcall hide-ifdef-evaluator expr))
- (exprstring (replace-regexp-in-string
- ;; Trim off leading/trailing whites
- "^[ \t]*\\|[ \t]*$" ""
- (replace-regexp-in-string
- "\\(//.*\\)" "" ; Trim off end-of-line comments
- (buffer-substring-no-properties start end)))))
- (cond
- ((and (<= (length tokens) 1) simple) ; Simple token
- (if defined
- (message "%S <= `%s'" result exprstring)
- (message "`%s' is not defined" exprstring)))
- ((integerp result)
- (if (or (= 0 result) (= 1 result))
- (message "%S <= `%s'" result exprstring)
- (message "%S (%#x) <= `%s'" result result exprstring)))
- ((null result) (message "%S <= `%s'" 'false exprstring))
- ((eq t result) (message "%S <= `%s'" 'true exprstring))
- (t (message "%S <= `%s'" result exprstring)))
+ ;; when prefixed, pass the error on for later
+ ;; `hide-ifdef-evaluator'
+ (if current-prefix-arg err))))))
+ (exprstring (hif-stringify tokens))
+ (result (condition-case err
+ (funcall hide-ifdef-evaluator expr)
+ ;; in case of arithmetic error or others
+ (error (error "Error: line %d %S when evaluating `%s'"
+ (line-number-at-pos) err exprstring)))))
+ (setq
+ result
+ (cond
+ ((= (length tokens) 0)
+ (message "`%s'" exprstring))
+ ((= (length tokens) 1) ; Simple token
+ (if simple
+ (if defined
+ (hif-display-macro exprstring result)
+ (if (and (hif-is-number exprstring)
+ result (numberp result))
+ (message "%S (%#x)" result result)
+ (if (and (hif-is-float exprstring)
+ result (numberp result))
+ (message "%S (%s)" result exprstring)
+ (if (string-match hif-string-literal-regexp exprstring)
+ (message "%s" exprstring)
+ (message "`%s' is not defined" exprstring)))))
+ (if defined
+ (hif-display-macro exprstring (cdr defined) result)
+ (message "`%s' is not defined" exprstring))))
+ ((integerp result)
+ (if (or (= 0 result) (= 1 result))
+ (message "%S <= `%s'" result exprstring)
+ (message "%S (%#x) <= `%s'" result result exprstring)))
+ ((null result)
+ (message "%S <= `%s'" 'false exprstring))
+ ((eq t result)
+ (message "%S <= `%s'" 'true exprstring))
+ (t
+ (message "%S <= `%s'" result exprstring))))
+ (run-hooks 'hide-ifdef-evalulate-leave-hook)
result))))
(defun hif-parse-macro-arglist (str)
@@ -1667,6 +2274,8 @@ first arg will be `hif-etc'."
;; the performance I use this `hif-simple-token-only' to notify my code and
;; save the final [value] into symbol database. [lukelee]
+(defvar hif-verbose-define-count 0)
+
(defun hif-find-define (&optional min max)
"Parse texts and retrieve all defines within the region MIN and MAX."
(interactive)
@@ -1676,8 +2285,11 @@ first arg will be `hif-etc'."
(let* ((defining (string= "define" (match-string 2)))
(name (and (re-search-forward hif-macroref-regexp max t)
(match-string 1)))
- (parmlist (and (match-string 3) ; First arg id found
- (hif-parse-macro-arglist (match-string 2)))))
+ (parmlist (or (and (match-string 3) ; First arg id found
+ (delq 'hif-space
+ (hif-parse-macro-arglist (match-string 2))))
+ (and (match-string 2) ; empty arglist
+ (list nil)))))
(if defining
;; Ignore name (still need to return 't), or define the name
(or (and hide-ifdef-exclude-define-regexp
@@ -1689,6 +2301,14 @@ first arg will be `hif-etc'."
(hif-simple-token-only nil) ; Dynamic binding
(tokens
(and name
+ (prog1 t
+ (cl-incf hif-verbose-define-count)
+ ;; only show 1/50 to not slow down to much
+ (if (and hide-ifdef-verbose
+ (= (% hif-verbose-define-count 50)
1))
+ (message "[Line %d] defining %S"
+ (line-number-at-pos (point))
+ (substring-no-properties name))))
;; `hif-simple-token-only' is set/clear
;; only in this block
(condition-case nil
@@ -1700,8 +2320,10 @@ first arg will be `hif-etc'."
;; this will stop hideif from searching
;; for more #defines.
(setq hif-simple-token-only t)
- (buffer-substring-no-properties
- start end)))))
+ (replace-regexp-in-string
+ "^[ \t]*\\|[ \t]*$" ""
+ (buffer-substring-no-properties
+ start end))))))
;; For simple tokens we save only the parsed result;
;; otherwise we save the tokens and parse it after
;; parameter replacement
@@ -1715,17 +2337,19 @@ first arg will be `hif-etc'."
`(hif-define-macro ,parmlist
,tokens))))
(SA (and name
- (assoc (intern name) hide-ifdef-env))))
+ (assq (intern name) hide-ifdef-env))))
(and name
(if SA
(or (setcdr SA expr) t)
- ;; Lazy evaluation, eval only if hif-lookup find it.
+ ;; Lazy evaluation, eval only if `hif-lookup' find
it.
;; Define it anyway, even if nil it's still in list
;; and therefore considered defined.
(push (cons (intern name) expr) hide-ifdef-env)))))
;; #undef
(and name
- (hif-undefine-symbol (intern name))))))
+ (intern-soft name)
+ (hif-undefine-symbol (intern name)))
+ t)))
t))
@@ -1735,7 +2359,10 @@ first arg will be `hif-etc'."
(save-excursion
(save-restriction
;; (mark-region min max) ;; for debugging
+ (setq hif-verbose-define-count 0)
+ (forward-comment (point-max))
(while (hif-find-define min max)
+ (forward-comment (point-max))
(setf min (point)))
(if max (goto-char max)
(goto-char (point-max))))))
@@ -1745,22 +2372,31 @@ first arg will be `hif-etc'."
It does not do the work that's pointless to redo on a recursive entry."
(save-excursion
(let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp'
- (expand-header (and hide-ifdef-expand-reinclusion-protection
+ (expand-header (and hide-ifdef-expand-reinclusion-guard
(buffer-file-name)
(string-match hide-ifdef-header-regexp
(buffer-file-name))
(zerop hif-recurse-level)))
(case-fold-search nil)
min max)
+ (setq hif-__COUNTER__ 0)
(goto-char (point-min))
(setf min (point))
- (cl-loop do
- (setf max (hif-find-any-ifX))
- (hif-add-new-defines min max)
- (if max
- (hif-possibly-hide expand-header))
- (setf min (point))
- while max))))
+ ;; Without this `condition-case' it would be easier to see which
+ ;; operation went wrong thru the backtrace `iff' user realize
+ ;; the underlying meaning of all hif-* operation; for example,
+ ;; `hif-shiftleft' refers to C(++) '<<' operator and floating
+ ;; operation arguments would be invalid.
+ (condition-case err
+ (cl-loop do
+ (setf max (hif-find-any-ifX))
+ (hif-add-new-defines min max)
+ (if max
+ (hif-possibly-hide expand-header))
+ (setf min (point))
+ while max)
+ (error (error "Error: failed at line %d %S"
+ (line-number-at-pos) err))))))
;;===%%SF%% hide-ifdef-hiding (End) ===
@@ -1821,13 +2457,17 @@ This allows #ifdef VAR to be hidden."
nil nil t nil "1")))
(list var val)))
(hif-set-var var (or val 1))
- (message "%s set to %s" var (or val 1))
- (sleep-for 1)
- (if hide-ifdef-hiding (hide-ifdefs)))
+ (if hide-ifdef-hiding (hide-ifdefs))
+ (message "%s set to %s" var (or val 1)))
(defun hif-undefine-symbol (var)
- (setq hide-ifdef-env
- (delete (assoc var hide-ifdef-env) hide-ifdef-env)))
+ (when (assq var hide-ifdef-env)
+ (setq hide-ifdef-env
+ (delete (assq var hide-ifdef-env) hide-ifdef-env))
+ ;; We can override things in `hif-predefine-alist' so keep them
+ (unless (assq var hif-predefine-alist)
+ (unintern (symbol-name var) nil))
+ t))
(defun hide-ifdef-undef (start end)
"Undefine a VAR so that #ifdef VAR would not be included."
@@ -1848,35 +2488,54 @@ This allows #ifdef VAR to be hidden."
(if hide-ifdef-hiding (hide-ifdefs))
(message "`%S' undefined" sym))))
-(defun hide-ifdefs (&optional nomsg)
+(defun hide-ifdefs (&optional start end nomsg)
"Hide the contents of some #ifdefs.
Assume that defined symbols have been added to `hide-ifdef-env'.
The text hidden is the text that would not be included by the C
preprocessor if it were given the file with those symbols defined.
With prefix command presents it will also hide the #ifdefs themselves.
+Hiding will only be performed within the marked region if there is one.
+
Turn off hiding by calling `show-ifdefs'."
- (interactive)
- (let ((hide-ifdef-lines current-prefix-arg))
- (or nomsg
- (message "Hiding..."))
- (setq hif-outside-read-only buffer-read-only)
- (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode
- (if hide-ifdef-hiding
- (show-ifdefs)) ; Otherwise, deep confusion.
- (setq hide-ifdef-hiding t)
- (hide-ifdef-guts)
- (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
- (or nomsg
- (message "Hiding done"))))
-
-
-(defun show-ifdefs ()
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
+
+ (setq current-prefix-arg (or hide-ifdef-lines current-prefix-arg))
+ (save-restriction
+ (let* ((hide-ifdef-lines current-prefix-arg)
+ (outer-hide-ifdef-verbose hide-ifdef-verbose)
+ (hide-ifdef-verbose (and outer-hide-ifdef-verbose
+ (not (or nomsg (use-region-p)))))
+ (hide-start-time (current-time)))
+ (and hide-ifdef-verbose
+ (message "Hiding..."))
+ (setq hif-outside-read-only buffer-read-only)
+ (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode
+ (if hide-ifdef-hiding
+ (show-ifdefs)) ; Otherwise, deep confusion.
+ (setq hide-ifdef-hiding t)
+ (narrow-to-region (or start (point-min)) (or end (point-max)))
+ (hide-ifdef-guts)
+ (setq buffer-read-only
+ (or hide-ifdef-read-only hif-outside-read-only))
+ (and hide-ifdef-verbose
+ (message "Hiding done, %.1f seconds elapsed"
+ (float-time (time-subtract (current-time)
+ hide-start-time)))))))
+
+
+(defun show-ifdefs (&optional start end)
"Cancel the effects of `hide-ifdef': show the contents of all #ifdefs."
- (interactive)
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
(setq buffer-read-only hif-outside-read-only)
- (hif-show-all)
+ (hif-show-all (or start (point-min)) (or end (point-max)))
(setq hide-ifdef-hiding nil))
@@ -1960,21 +2619,17 @@ With optional prefix argument ARG, also hide the
#ifdefs themselves."
;;; definition alist support
+;; The old implementation that match symbol only to 't is now considered
+;; obsolete.
(defvar hide-ifdef-define-alist nil
"A global assoc list of pre-defined symbol lists.")
-(defun hif-compress-define-list (env)
- "Compress the define list ENV into a list of defined symbols only."
- (let ((new-defs nil))
- (dolist (def env new-defs)
- (if (hif-lookup (car def)) (push (car def) new-defs)))))
-
(defun hide-ifdef-set-define-alist (name)
"Set the association for NAME to `hide-ifdef-env'."
(interactive "SSet define list: ")
- (push (cons name (hif-compress-define-list hide-ifdef-env))
- hide-ifdef-define-alist))
+ (push (cons name hide-ifdef-env)
+ hide-ifdef-define-alist))
(defun hide-ifdef-use-define-alist (name)
"Set `hide-ifdef-env' to the define list specified by NAME."
@@ -1986,9 +2641,8 @@ With optional prefix argument ARG, also hide the #ifdefs
themselves."
(if (stringp name) (setq name (intern name)))
(let ((define-list (assoc name hide-ifdef-define-alist)))
(if define-list
- (setq hide-ifdef-env
- (mapcar (lambda (arg) (cons arg t))
- (cdr define-list)))
+ (setq hide-ifdef-env
+ (cdr define-list))
(error "No define list for %s" name))
(if hide-ifdef-hiding (hide-ifdefs))))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 87e7390: * lisp/progmodes/hideif.el: update for new C++ standards and extensions,
Luke Lee <=