Function: hif-macro-supply-arguments
hif-macro-supply-arguments is a byte-compiled function defined in
hideif.el.gz.
Signature
(hif-macro-supply-arguments MACRO-NAME ACTUAL-PARMS)
Documentation
Expand a macro call, replace ACTUAL-PARMS in the macro body.
Source Code
;; Defined in /usr/src/emacs/lisp/progmodes/hideif.el.gz
;; 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 (assq 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)))
actual-count
formal-count
formal
etc)
(when (and actual-parms formal-parms macro-body)
;; For each actual parameter, evaluate each one and associate it
;; with an actual parameter, put it into local table and finally
;; evaluate the macro body.
(if (setq etc (or (eq (car formal-parms) 'hif-etc)
(and (eq (car formal-parms) 'hif-etc-c99) 'c99)))
;; 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))
;; Fix empty arguments applied
(if (and (= formal-count 1)
(null (car formal-parms)))
(setq formal-parms nil
formal-count (1- formal-count)))
(if (and (= actual-count 1)
(or (null (car actual-parms))
;; white space as the only argument
(equal '(hif-space) (car actual-parms))))
(setq actual-parms nil
actual-count (1- actual-count)))
;; Basic error checking
(if etc
(if (eq etc 'c99)
(if (and (> formal-count 1) ; f(a,b,...)
(< actual-count formal-count))
(error "C99 variadic argument macro %S need at least %d arguments"
macro-name formal-count))
;; GNU style variadic argument
(if (and (> formal-count 1)
(< actual-count (1- formal-count)))
(error "GNU variadic argument macro %S need at least %d arguments"
macro-name (1- formal-count))))
(if (> formal-count actual-count)
(error "Too few parameters for macro %S; %d instead of %d"
macro-name actual-count formal-count)
(if (< formal-count actual-count)
(error "Too many parameters for macro %S; %d instead of %d"
macro-name actual-count formal-count))))
;; Perform token replacement on the MACRO-BODY with the parameters
;; Every substituted argument in the macro-body must be in list form so
;; that it won't again be substituted incorrectly in later iterations.
;; Finally we will flatten the list to fix that.
(cl-loop
do
;; Note that C99 '...' and GNU 'x...' allow empty match
(setq formal (pop formal-parms))
;;
;; Prevent repetitive substitution, 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 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).
;; Unlike `subst', `cl-substitute' replace only the top level
;; instead of the whole tree; more importantly, it's not
;; destructive.
;;
(if (not (and (null formal-parms) etc))
;; One formal with one actual
(setq macro-body
(cl-substitute (car actual-parms) formal macro-body))
;; `formal-parms' used up, now take care of '...'
(cond
((eq etc 'c99) ; C99 __VA_ARGS__ style '...'
(when formal
(setq macro-body
(cl-substitute (car actual-parms) formal macro-body))
;; Now the whole __VA_ARGS__ represents the whole
;; remaining actual params
(pop actual-parms))
;; Replace if __VA_ARGS__ presents:
;; if yes, see if it's prefixed with ", ##" or not,
;; if yes, remove the "##", then if actual-params is
;; exhausted, remove the prefixed ',' as well.
;; Prepare for destructive operation
(let ((rem-body (copy-sequence macro-body))
new-body va left part)
;; Find each __VA_ARGS__ and remove its immediate prefixed '##'
;; and comma if presents and if `formal_param' is exhausted
(while (setq va (cl-position '__VA_ARGS__ rem-body))
;; Split REM-BODY @ __VA_ARGS__ into LEFT and right
(setq part nil)
(if (zerop va)
(setq left nil ; __VA_ARGS__ trimmed
rem-body (cdr rem-body))
(setq left rem-body
rem-body (cdr (nthcdr va rem-body))) ; _V_ removed
(setcdr (nthcdr va left) nil) ; now _V_ be the last in LEFT
;; now LEFT=(, w? ## w? _V_) rem=(W X Y) where w = white space
(setq left (cdr (nreverse left)))) ; left=(w? ## w? ,)
;; Try to recognize w?##w? and remove ", ##" if found
;; (remember head = __VA_ARGS__ is temporarily removed)
(while (and left (eq 'hif-space (car left))) ; skip whites
(setq part (cons 'hif-space part)
left (cdr left)))
(if (eq (car left) 'hif-token-concat) ; match '##'
(if actual-parms
;; Keep everything
(setq part (append part (cdr left)))
;; `actual-params' exhausted, delete ',' if presents
(while (and left (eq 'hif-space (car left))) ; skip whites
(setq part (cons 'hif-space part)
left (cdr left)))
(setq part
(append part
(if (eq (car left) 'hif-comma) ; match ','
(cdr left)
left))))
;; No immediate '##' found
(setq part (append part left)))
;; Insert __VA_ARGS__ as a list
(push (hif-delimit actual-parms 'hif-comma) part)
;; Reverse `left' back
(setq left (nreverse part)
new-body (append new-body left)))
;; Replacement of __VA_ARGS__ done here, add rem-body back
(setq macro-body (append new-body rem-body)
actual-parms nil)))
(etc ; GNU style '...', substitute last argument
(if (null actual-parms)
;; Must be non-destructive otherwise the original function
;; definition defined in `hide-ifdef-env' will be destroyed.
(setq macro-body (remove formal macro-body))
(setq macro-body
(cl-substitute (hif-delimit actual-parms 'hif-comma)
formal macro-body)
actual-parms nil)))
(t
(error "Internal error: impossible case"))))
(pop actual-parms)
while actual-parms) ; end cl-loop
;; 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))))
;; Token concatenation happens here, keep single 'hif-space
(hif-keep-single (hif-token-concatenation macro-body) 'hif-space)))