From 38d37e865359435d59196b894c36e87d5883fbe0 Mon Sep 17 00:00:00 2001
From: Luke Lee <luke.yx.lee@gmail.com>
Date: Wed, 4 Dec 2013 15:15:41 +0800
Subject: [PATCH 2/4] Aggregate enhancements for hideif macro expansion.

* Supporting argumented macro expansion.
* Stringification, tokenization and concatenation of strings and tokens.
* Add functions to find defines and parse argumented macros into a macro tree
  containing macro name, formal parameters and macro body.
* Later macro expansion time it will be applied by actual parameters and then
  got expanded recursively.
---
 lisp/progmodes/hideif.el | 454 ++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 431 insertions(+), 23 deletions(-)

diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index cbee895..c53036b 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -104,6 +104,7 @@
 ;;; Code:

 (require 'cc-mode)
+(eval-when-compile (require 'cl))

 (defgroup hide-ifdef nil
   "Hide selected code within `ifdef'."
@@ -135,6 +136,10 @@
   :group 'hide-ifdef
   :version "23.1")

+(defcustom hide-ifdef-exclude-define-regexp-pattern nil
+  "Ignore #define name if that name match this exclusion pattern."
+  :type 'string
+  :group 'hide-ifdef)

 (defvar hide-ifdef-mode-submap
   ;; Set up the submap that goes after the prefix key.
@@ -365,9 +370,20 @@ that form should be displayed.")
 (defconst hif-else-regexp (concat hif-cpp-prefix "else"))
 (defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
 (defconst hif-ifx-else-endif-regexp
-  (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
+  (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
+(defconst hif-macro-expr-prefix-regexp (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+"))

 (defconst hif-white         "[ \t]*")
+(defconst hif-define        (concat hif-cpp-prefix "\\(define\\|undef\\)"))
+(defconst hif-id            (concat "[A-Za-z_][0-9A-Za-z_]*"))
+(defconst hif-macroname     (concat hif-white "\\(" hif-id "\\)" hif-white
+                                    "\\("
+                                    "(" hif-white
+                                      "\\(" hif-id "\\)?" hif-white
+                                      "\\(" "," hif-white hif-id hif-white "\\)*"
+                                      "\\(\\.\\.\\.\\)?" hif-white
+                                    ")"
+                                    "\\)?" ))

 ;; Used to store the current token and the whole token list during parsing.
 ;; Only bound dynamically.
@@ -400,7 +416,12 @@ that form should be displayed.")
     ("/"   . hif-divide)
     ("%"   . hif-modulo)
     ("?"  . hif-conditional)
-    (":"  . hif-colon)))
+    (":"   . hif-colon)
+    (","   . hif-comma)
+    ("#"   . hif-stringify)
+    ("..." . hif-etc)))
+
+(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))

 (defconst hif-token-regexp
   (concat (regexp-opt (mapcar 'car hif-token-alist))
@@ -430,7 +451,7 @@ that form should be displayed.")
             (push (substring-no-properties (match-string 1)) token-list)
             (goto-char (match-end 0)))
 	   ((looking-at hif-token-regexp)
-	    (let ((token (buffer-substring (point) (match-end 0))))
+            (let ((token (buffer-substring-no-properties (point) (match-end 0))))
 	      (goto-char (match-end 0))
 	      ;; (message "token: %s" token) (sit-for 1)
 	      (push (or (cdr (assoc token hif-token-alist))
@@ -479,9 +500,107 @@ that form should be displayed.")
   "Pop the next token from token-list into the let variable \"hif-token\"."
   (setq hif-token (pop hif-token-list)))

-(defun hif-parse-if-exp (token-list)
+(defsubst hif-if-valid-identifier (id)
+  (not (or (numberp id)
+           (stringp id))))
+
+(defun hif-define-operator (tokens)
+  "`Upgrade' hif-define xxx to '(hif-define xxx)' so that it won't be subsitituted"
+  (let ((result nil)
+        (tok nil))
+    (while tokens
+      (setq tok (car tokens)
+            tokens (cdr tokens))
+      (setq result
+            (append
+             result
+             (list
+              (if (eq tok 'hif-defined)
+                  (progn
+                    (setq tok (cadr tokens))
+                    (if (eq (car tokens) 'hif-lparen)
+                        (if (and (hif-if-valid-identifier tok)
+                                 (eq (caddr tokens) 'hif-rparen))
+                            (setq tokens (cdddr tokens))
+                          (error "operator \"defined\" requires an identifier"))
+                      (setq tok (car tokens)
+                            tokens (cdr tokens))
+                      (unless (hif-if-valid-identifier tok)
+                        (error "operator \"defined\" requires an identifier")))
+                    (list 'hif-defined 'hif-lparen tok 'hif-rparen))
+                tok)))))
+    result))
+
+(defun hif-flatten (l)
+  "Flatten a tree"
+  (if (and l (atom l))
+      (list l)
+    (if (consp l)
+        (nconc (hif-flatten (car l)) (hif-flatten (cdr l))))))
+
+(defun hif-expand-token-list (tokens &optional macroname reflist)
+  ;; 'reflist' is the reference list to prevent self-referencing
+  "Perform expansion till everything expanded. No self-reference expansion."
+  (catch 'self-referencing
+    (let ((expanded nil)
+          (remains (hif-define-operator
+                    (hif-token-concatenation (hif-token-stringification tokens))))
+          tok rep)
+      (if macroname
+          (setq reflist (cons macroname reflist)))
+      ;; Expanding all tokens till list exhausted
+      (while remains
+        (setq tok (car remains)
+              remains (cdr remains))
+        (if (memq tok reflist) ;; for self-referencing tokens, don't expand it
+            (throw 'self-referencing tokens))
+        (setq expanded
+              (append
+               expanded
+               (cond
+                ((or (memq tok hif-valid-token-list)
+                     (numberp tok)
+                     (stringp tok))
+                 (list tok))
+
+                ((setq rep (hif-lookup tok))
+                 (if (and (listp rep)
+                          (eq (car rep) 'hif-define-macro)) ;; a defined macro
+                     ;; recursively expand it
+                     (if (cadr rep) ;; arglist is not nil
+                         (if (eq (car remains) 'hif-lparen)
+                             ;; Argumented macro, get arguments and invoke it
+                             (let* ((hif-token-list (cdr remains)) ;; dynamic binding for hif-macro-supply-arguments
+                                    (hif-token nil)                ;; dynamic binding for hif-macro-supply-arguments
+                                    (parmlist (mapcar 'hif-expand-token-list
+                                                      (hif-get-argument-list tok)))
+                                    (result (hif-expand-token-list (hif-macro-supply-arguments tok parmlist)
+                                                                   tok reflist)))
+                               (setq remains (cons hif-token hif-token-list))
+                               result)
+                           ;; no argument supplied, no invocation for this macro
+                           (list tok))
+                       ;; arglist is nil, direct expansion
+                       (setq rep (hif-expand-token-list (caddr rep) ;; macro's token list
+                                                        tok reflist))
+                       (setq remains (substitute tok rep remains)) ;; replace all remaining references immediately
+                       (list rep))
+                   ;; lookup tok returns an atom
+                   (list rep)))
+
+                ;;[2013-10-22 16:06:12 +0800] Must keep the token, removeing this token might results in
+                ;;                            an incomplete expression that cannot be parsed further.
+                ;;((= 1 (hif-defined tok)) ;; defined (hif-defined tok)=1, but empty (hif-lookup tok)=nil, thus remove this token
+                ;; (setq remains (delete tok remains))
+                ;; nil)
+
+                (t ;; usual IDs
+                 (list tok))))))
+      (hif-flatten expanded))))
+
+(defun hif-parse-if-exp (token-list &optional macroname)
   "Parse the TOKEN-LIST.  Return translated list in prefix form."
-  (let ((hif-token-list token-list))
+  (let ((hif-token-list (hif-expand-token-list token-list macroname)))
     (hif-nexttoken)
     (prog1
         (and hif-token
@@ -645,6 +764,8 @@ that form should be displayed.")

    ((numberp hif-token)
     (prog1 hif-token (hif-nexttoken)))
+   ((stringp hif-token)
+    (hif-string-concatenation))

    ;; Unary plus/minus.
    ((memq hif-token '(hif-minus hif-plus))
@@ -652,10 +773,105 @@ that form should be displayed.")

    (t					; identifier
     (let ((ident hif-token))
-      (if (memq ident '(or and))
-	  (error "Error: missing identifier"))
       (hif-nexttoken)
-      `(hif-lookup (quote ,ident))))))
+      (if (eq hif-token 'hif-lparen)
+          (hif-place-macro-invocation ident)
+        `(hif-lookup (quote ,ident)))))))
+
+(defun hif-get-argument-list (ident)
+  (let ((nest 0)
+        (parmlist nil) ;; a "token" list of parameters, will later be parsed
+        (parm nil))
+    (while (or (not (eq (hif-nexttoken) 'hif-rparen))
+               (/= nest 0))
+      (if (eq (car parm) 'hif-comma)
+          (setq parm nil))
+      (cond
+       ((eq hif-token 'hif-lparen)
+        (setq nest (1+ nest)))
+       ((eq hif-token 'hif-rparen)
+        (setq nest (1- nest))
+        (if (< nest 0)
+            (error "Unbalanced parenthesis when invoking macro %S" ident)))
+       ((and (eq hif-token 'hif-comma)
+             (= nest 0))
+        (setq parmlist (append parmlist (list parm))
+              parm nil)))
+      (setq parm (append parm (list hif-token))))
+    (setq parmlist (append parmlist (list parm))) ; okay even if parm is nil
+    (hif-nexttoken) ; drop the hif-rparen, get next token
+    parmlist))
+
+(defun hif-place-macro-invocation (ident)
+  (let ((parmlist (hif-get-argument-list ident)))
+    `(hif-invoke (quote ,ident) (quote ,parmlist))))
+
+(defun hif-string-concatenation ()
+  "Parse concatenated strings: string | strings string"
+  (let ((result (substring-no-properties hif-token)))
+    (while (stringp (hif-nexttoken))
+      (setq result (concat
+                    (substring result 0 -1)    ; remove trailing '"'
+                    (substring hif-token 1)))) ; remove leading  '"'
+    result))
+
+(defun hif-define-macro (parmlist token-body)
+  "A marker for defined macro with arguments, cannot be evaluated alone with no parameters inputed."
+  ;; TODO: input parameters at run time, use minibuffer to query all parameters
+  (error "Argumented macro cannot be evaluated without passing any parameter."))
+
+(defun hif-stringify (a)
+  "Stringify a number, string or symbol"
+  (cond
+   ((numberp a)
+    (number-to-string a))
+   ((atom a)
+    (symbol-name a))
+   ((stringp a)
+    (concat "\"" a "\""))
+   (t
+    (error "Invalid token to stringify"))))
+
+(defun intern-safe (str)
+  (if (stringp str)
+      (intern str)))
+
+(defun hif-merge-operator-token (a b)
+  "Support weird (but valid) use of token concatenation. Here we take care only those that can be evaluated during
+preprocessing time. For those computable syntax that can only be evaluated during C runtime (like '++','--','+='...),
+we ignore them all here."
+  (cond
+   ((and (eq a 'hif-logior) (eq b 'hif-logior)) ;; '|''|' -> '||'
+    'hif-or)
+   ((and (eq a 'hif-logand) (eq b 'hif-logand)) ;; '&''&' -> '&&'
+    'hif-and)
+   ((and (eq a 'hif-assign) (eq b 'hif-assign)) ;; '=''=' -> '=='
+    'hif-equal)
+   ((and (eq a 'hif-not) (eq b 'hif-assign)) ;; '!''=' -> '!='
+    'hif-notequal)
+   ((eq a 'hif-less)
+    (if (eq b 'hif-less) ;; '<''<' -> '<<'
+        'hif-shiftleft
+      (if (eq b 'hif-assign) ;; '<''=' -> '<='
+          'hif-less-equal)))
+   ((eq a 'hif-greater)
+    (if (eq b 'hif-greater) ;; '>''>' -> '>>'
+        'hif-shiftleft
+      (if (eq b 'hif-assign) ;; '>''=' -> '>='
+          'hif-greater-equal)))))
+
+(defun hif-token-concat (a b)
+  "Concatenation two symbol name into a longer symbol, currently support only simple symbol concatenation."
+  (if (or (memq a hif-valid-token-list)
+          (memq b hif-valid-token-list))
+      (let ((result (hif-merge-operator-token a b)))
+        (or result
+            ;;(error "Invalid token to concatenate")
+            (error "pasting \"%s\" and \"%s\" does not give a valid preprocessing token"
+                   (if (memq a hif-valid-token-list) (car (rassoc a hif-token-alist)) (symbol-name a))
+                   (if (memq b hif-valid-token-list) (car (rassoc b hif-token-alist)) (symbol-name b)))))
+    (intern-safe (concat (hif-stringify a)
+                         (hif-stringify b)))))

 (defun hif-mathify (val)
   "Treat VAL as a number: if it's t or nil, use 1 or 0."
@@ -716,23 +932,149 @@ that form should be displayed.")
         (setq result (funcall hide-ifdef-evaluator e))))
     result))

+(defun hif-token-stringification (l)
+  "Scan token list for 'hif-stringify' ('#') token and stringify the next token"
+  (let (result)
+    (while l
+      (setq result
+            (append result
+                    (list
+                     (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)))))
+      (setq l (cdr l)))
+    result))
+
+(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)))
+
+(defun hif-delimit (l a)
+  "Delmit a list 'l' with delimiter atom 'd'"
+  (nconc (mapcan (lambda (l)
+                   (list l a))  (butlast l))
+         (last l)))
+
+;; Perform token replacement:
+(defun hif-macro-supply-arguments (macro-name actual-parms)
+  "Expand a macro function, replace 'actual-parms' to the function body."
+  (let* ((SA                   (assoc macro-name hide-ifdef-env))
+         (macro                (and SA
+                                    (cdr SA)
+                                    (eq (cadr SA) 'hif-define-macro)
+                                    (cddr SA)))
+         (formal-parms         (and macro (car macro)))
+         (macro-body           (and macro (cadr macro)))
+         (hide-ifdef-local-env nil) ;; dynamic binding local table
+         actual-count
+         formal-count
+         actual
+         formal
+         etc)
+
+    (when (and actual-parms formal-parms macro-body)
+      ;; For each actual parameter, evaluate each one and associate it
+      ;; with the associated actual parameter, put it into local table and finally
+      ;; evaluate the macro body.
+      (if (setq etc (eq (car formal-parms) 'hif-etc)) ;; Take care of 'hif-etc first. Prefix 'hif-comma back if needed.
+          (setq formal-parms (cdr formal-parms)))
+      (setq formal-count (length formal-parms)
+            actual-count (length actual-parms))
+
+      (if (> formal-count actual-count)
+          (error "Too few parmameter for macro %S" macro-name)
+        (if (< formal-count actual-count)
+            (or etc
+                (error "Too many parameters for macro %S" macro-name))))
+
+      ;; Perform token replacement on the macro-body on the parameters
+      (while (setq formal (car formal-parms))
+        (setq formal-parms (cdr formal-parms))
+        ;; Prevent repettative substitutation, thus cannot use 'subst'
+        ;; for example:
+        ;; #define mac(a,b) (a+b)
+        ;; #define testmac mac(b,y)
+        ;; testmac should expand to (b+y): replace of argument a and b occurs simultaneously
+        ;; not sequentially. If this occurs sequentially according to the argument order,
+        ;;  it will become: 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) becomes (b+b)
+        ;;  2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) becomes (y+y).
+        (setq macro-body
+              ;; Unlike 'subst', 'substitute' replace only the top level instead of the whole tree,
+              ;; more importantly, it's not destructive.
+              (if (and etc (null formal-parms))
+                  (substitute (hif-delimit actual-parms 'hif-comma) formal macro-body)
+                (substitute (car actual-parms) formal macro-body)))
+        (setq actual-parms (cdr actual-parms)))
+
+      ;; Replacement completed, flatten the whole token list,
+      (setq macro-body (hif-flatten macro-body))
+
+      ;; Stringification and token concatenation happens here
+      (hif-token-concatenation (hif-token-stringification macro-body)))))
+
+(defun hif-invoke (macro-name actual-parms)
+  "Invoke a macro by first expanding it, then reparse the macro-body, finally invoke the macro."
+    ;; Reparse the macro body and evaluate it
+    (funcall hide-ifdef-evaluator
+             (hif-parse-if-exp
+              (hif-macro-supply-arguments macro-name actual-parms)
+              macro-name)))

 ;;;----------- end of parser -----------------------


-(defun hif-canonicalize ()
-  "When at beginning of #ifX, return a Lisp expression for its condition."
+(defun hif-canonicalize-tokens (regexp) ;; for debugging
+  "Return the expanded result of the scanned tokens."
   (save-excursion
-    (let ((negate (looking-at hif-ifndef-regexp)))
-      (re-search-forward hif-ifx-regexp)
+    (re-search-forward regexp)
+    (let* ((curr-regexp (match-string 0))
+           (defined (string-match hif-ifxdef-regexp curr-regexp))
+           (negate (and defined
+                        (string= (match-string 2 curr-regexp) "n"))))
       (let* ((tokens (hif-tokenize (point)
-				   (progn (hif-end-of-line) (point))))
-	     (expr (hif-parse-if-exp tokens)))
-	;; (message "hif-canonicalized: %s" expr)
+                                   (progn (hif-end-of-line) (point)))))
+        (if defined
+            (setq tokens (list 'hif-defined tokens)))
 	(if negate
-	    (list 'hif-not expr)
-	  expr)))))
+            (setq tokens (list 'hif-not tokens)))
+        tokens))))

+(defun hif-canonicalize (regexp)
+  "When at beginning of `regexp' (i.e. #ifX), return a Lisp expression for its condition."
+  (let ((case-fold-search nil))
+    (save-excursion
+      (re-search-forward regexp)
+      (let* ((curr-regexp (match-string 0))
+             (defined (string-match hif-ifxdef-regexp curr-regexp))
+             (negate (and defined
+                          (string= (match-string 2 curr-regexp) "n")))
+             (tokens (hif-tokenize (point)
+                                   (progn (hif-end-of-line) (point)))))
+        (if defined
+            (setq tokens (list 'hif-defined tokens)))
+        (if negate
+            (setq tokens (list 'hif-not tokens)))
+        (hif-parse-if-exp tokens)))))

 (defun hif-find-any-ifX ()
   "Move to next #if..., or #ifndef, at point or after."
@@ -991,7 +1333,7 @@ Point is left unchanged."
   "Called at #ifX expression, this hides those parts that should be hidden.
 It uses the judgment of `hide-ifdef-evaluator'."
   ;; (message "hif-possibly-hide") (sit-for 1)
-  (let ((test (hif-canonicalize))
+  (let ((test (hif-canonicalize hif-ifx-regexp))
 	(range (hif-find-range)))
     ;; (message "test = %s" test) (sit-for 1)

@@ -1019,6 +1361,65 @@ It uses the judgment of `hide-ifdef-evaluator'."
     (goto-char (hif-range-end range))
     (end-of-line)))

+(defun hif-parse-macro-arglist (str)
+  "Parse argument list formatted as '( arg1 [ , argn] [...] )', includeing the '...'
+Return a list of the arguments, if '...' exists the first arg will be hif-etc."
+  (let ((tokenlist (cdr (hif-tokenize (- (point) (length str)) (point)))) ; remove hif-lparen
+        result token)
+    (while (not (eq (setq token (car tokenlist)) 'hif-rparen))
+      (setq tokenlist (cdr tokenlist))
+      (cond
+       ((eq token 'hif-etc)
+        (setq result (cons 'hif-etc result)))
+       ((eq token 'hif-comma)
+        t)
+       (t
+        (setq result (append result (cons token nil))))))
+    result))
+
+(defun hif-find-define (&optional min max)
+  (interactive)
+  (and min (goto-char min))
+  (and (re-search-forward hif-define max t)
+       (or
+        (let* ((defining (string= "define" (match-string 2)))
+               (name (and (re-search-forward hif-macroname max t)
+                          (match-string 1)))
+               (parsed nil)
+               (parmlist (and (match-string 3) ;; first arg id found
+                              (hif-parse-macro-arglist (match-string 2)))))
+          (if defining
+              ;; ignore name (still need to return 't), or define the name
+              (or (and hide-ifdef-exclude-define-regexp-pattern
+                       (string-match hide-ifdef-exclude-define-regexp-pattern name))
+
+                  (let* ((start (point))
+                         (end   (progn (hif-end-of-line) (point)))
+                         (tokens (and name
+                                      (condition-case nil ;; prevent C statement things like 'do { ... } while (0)'
+                                          (hif-tokenize start end)
+                                        (error ;; we can't just return nil since this will stop searching for the remaining #defines.
+                                         (setq hif-simple-token-only t)
+                                         (buffer-substring-no-properties start end)))))
+                         ;; For simple token we save only the parsed result;
+                         ;; or we save the tokens, parse it after parameter replacement
+                         (expr (and tokens
+                                    (or (and hif-simple-token-only
+                                             (listp tokens)
+                                             (= (length tokens) 1)
+                                             (hif-parse-if-exp tokens))
+                                        `(hif-define-macro ,parmlist ,tokens))))
+                         (SA (and name
+                                  (assoc (intern name) hide-ifdef-env))))
+                    (and name
+                         (if SA
+                             (or (setcdr SA expr) t) ;; Lazy evaluation, eval only if hif-lookup find it
+                           ;; define it anyway, even if nil it's still in list and therefore considerred defined
+                           (push (cons (intern name) expr) hide-ifdef-env)))))
+            ;; #undef
+            (and name
+                 (hif-undefine-symbol (intern name))))))
+       t))


 (defun hide-ifdef-guts ()
@@ -1078,12 +1479,16 @@ It does not do the work that's pointless to redo on a recursive entry."
   (hif-set-var var 1)
   (if hide-ifdef-hiding (hide-ifdefs)))

-(defun hide-ifdef-undef (var)
-  "Undefine a VAR so that #ifdef VAR would not be included."
-  (interactive "SUndefine what? ")
-  (hif-set-var var nil)
-  (if hide-ifdef-hiding (hide-ifdefs)))
+(defun hif-undefine-symbol (var)
+  (setq hide-ifdef-env
+        (delete (assoc var hide-ifdef-env) hide-ifdef-env)))

+;;(defun hide-ifdef-undef (var)
+;;  "Undefine a VAR so that #ifdef VAR would not be included."
+;;  (interactive "SUndefine what? ")
+;;  ;;(hif-set-var var nil);;Luke fixed: set it nil is still considered defined so #ifdef VAR is still true.
+;;  (hif-undefine-symbol var)
+;;  (if hide-ifdef-hiding (hide-ifdefs)))

 (defun hide-ifdefs (&optional nomsg)
   "Hide the contents of some #ifdefs.
@@ -1195,5 +1600,8 @@ Return as (TOP . BOTTOM) the extent of ifdef block."
     (if hide-ifdef-hiding (hide-ifdefs))))

 (provide 'hideif)
+;; Local variables:
+;; byte-compile-warnings: (not cl-functions)
+;; End:

 ;;; hideif.el ends here
--
1.8.3.24.g67b0998

