summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2013-08-04 16:18:11 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2013-08-04 16:18:11 -0400
commit671d5c16547d16bef2efa056705bd35b5feacc29 (patch)
tree4bc2c3774ce9914f21508d0e2a83e25504dbc1db
parente443729d658ee2b9e0f55bbbb90241819bf516a6 (diff)
downloademacs-671d5c16547d16bef2efa056705bd35b5feacc29.tar.gz
* lisp/subr.el (macrop): New function.
(text-clone--maintaining): New var. (text-clone--maintain): Rename from text-clone-maintain. Use it instead of inhibit-modification-hooks. * lisp/emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use a proxy, so as handle autoloads and redefinitions of the target. (advice--defalias-fset, advice-remove): Use advice--symbol-function. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Remove bogus (arrayp . stringp) pair. Add entries for `vectorp'. (pcase--mutually-exclusive-p): New function. (pcase--split-consp): Use it. (pcase--split-pred): Use it. Optimize the case where `pat' is a qpat mutually exclusive with the current predicate. * test/automated/advice-tests.el (advice-tests-nadvice): Test removal before definition. (advice-tests-macroaliases): New test. * lisp/emacs-lisp/edebug.el (edebug-lookup-function): Remove function. (edebug-macrop): Remove. Use `macrop' instead. * lisp/emacs-lisp/advice.el (ad-subr-p): Remove. Use `subrp' instead. (ad-macro-p): * lisp/eshell/esh-cmd.el (eshell-macrop): * lisp/apropos.el (apropos-macrop): Remove. Use `macrop' instead.
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/ChangeLog25
-rw-r--r--lisp/apropos.el13
-rw-r--r--lisp/emacs-lisp/advice.el30
-rw-r--r--lisp/emacs-lisp/edebug.el15
-rw-r--r--lisp/emacs-lisp/nadvice.el23
-rw-r--r--lisp/emacs-lisp/pcase.el31
-rw-r--r--lisp/eshell/esh-cmd.el10
-rw-r--r--lisp/subr.el24
-rw-r--r--test/ChangeLog6
-rw-r--r--test/automated/advice-tests.el17
11 files changed, 106 insertions, 90 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 60a846b459f..507cd04aa10 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -691,7 +691,7 @@ These attributes are only meaningful for coding-systems of type
with the same interpretation as the returned value of `visited-file-modtime'.
** time-to-seconds is not obsolete any more.
-** New function special-form-p.
+** New functions special-form-p and macrop.
** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
text-property on the first char.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dc1fa09b316..66bf7422b0d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,30 @@
2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+ * subr.el (macrop): New function.
+ (text-clone--maintaining): New var.
+ (text-clone--maintain): Rename from text-clone-maintain. Use it
+ instead of inhibit-modification-hooks.
+
+ * emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use
+ a proxy, so as handle autoloads and redefinitions of the target.
+ (advice--defalias-fset, advice-remove): Use advice--symbol-function.
+
+ * emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
+ Remove bogus (arrayp . stringp) pair. Add entries for `vectorp'.
+ (pcase--mutually-exclusive-p): New function.
+ (pcase--split-consp): Use it.
+ (pcase--split-pred): Use it. Optimize the case where `pat' is a qpat
+ mutually exclusive with the current predicate.
+
+ * emacs-lisp/edebug.el (edebug-lookup-function): Remove function.
+ (edebug-macrop): Remove. Use `macrop' instead.
+ * emacs-lisp/advice.el (ad-subr-p): Remove. Use `subrp' instead.
+ (ad-macro-p):
+ * eshell/esh-cmd.el (eshell-macrop):
+ * apropos.el (apropos-macrop): Remove. Use `macrop' instead.
+
+2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
* emacs-lisp/nadvice.el (advice-function-mapc): Rename from advice-mapc.
(advice-mapc): New function, using it.
(advice-function-member-p): New function.
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 000d2d87d05..7a1a6f6a75a 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1121,7 +1121,7 @@ If non-nil TEXT is a string that will be printed as a heading."
(apropos-print-doc 2
(if (commandp symbol)
'apropos-command
- (if (apropos-macrop symbol)
+ (if (macrop symbol)
'apropos-macro
'apropos-function))
(not nosubst))
@@ -1139,17 +1139,6 @@ If non-nil TEXT is a string that will be printed as a heading."
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
-(defun apropos-macrop (symbol)
- "Return t if SYMBOL is a Lisp macro."
- (and (fboundp symbol)
- (consp (setq symbol
- (symbol-function symbol)))
- (or (eq (car symbol) 'macro)
- (if (autoloadp symbol)
- (memq (nth 4 symbol)
- '(macro t))))))
-
-
(defun apropos-print-doc (i type do-keys)
(let ((doc (nth i apropos-item)))
(when (stringp doc)
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index eb1d63e788b..861054e777f 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2140,14 +2140,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
"Take a macro function DEFINITION and make a lambda out of it."
`(cdr ,definition))
-(defmacro ad-subr-p (definition)
- ;;"non-nil if DEFINITION is a subr."
- (list 'subrp definition))
-
-(defmacro ad-macro-p (definition)
- ;;"non-nil if DEFINITION is a macro."
- `(eq (car-safe ,definition) 'macro))
-
(defmacro ad-lambda-p (definition)
;;"non-nil if DEFINITION is a lambda expression."
`(eq (car-safe ,definition) 'lambda))
@@ -2160,12 +2152,12 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
(defmacro ad-compiled-p (definition)
"Return non-nil if DEFINITION is a compiled byte-code object."
`(or (byte-code-function-p ,definition)
- (and (ad-macro-p ,definition)
- (byte-code-function-p (ad-lambdafy ,definition)))))
+ (and (macrop ,definition)
+ (byte-code-function-p (ad-lambdafy ,definition)))))
(defmacro ad-compiled-code (compiled-definition)
"Return the byte-code object of a COMPILED-DEFINITION."
- `(if (ad-macro-p ,compiled-definition)
+ `(if (macrop ,compiled-definition)
(ad-lambdafy ,compiled-definition)
,compiled-definition))
@@ -2173,7 +2165,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
"Return the lambda expression of a function/macro/advice DEFINITION."
(cond ((ad-lambda-p definition)
definition)
- ((ad-macro-p definition)
+ ((macrop definition)
(ad-lambdafy definition))
((ad-advice-p definition)
(cdr definition))
@@ -2183,7 +2175,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
"Return the argument list of DEFINITION."
(require 'help-fns)
(help-function-arglist
- (if (or (ad-macro-p definition) (ad-advice-p definition))
+ (if (or (macrop definition) (ad-advice-p definition))
(cdr definition)
definition)
'preserve-names))
@@ -2229,7 +2221,7 @@ definition (see the code for `documentation')."
(defun ad-advised-definition-p (definition)
"Return non-nil if DEFINITION was generated from advice information."
(if (or (ad-lambda-p definition)
- (ad-macro-p definition)
+ (macrop definition)
(ad-compiled-p definition))
(let ((docstring (ad-docstring definition)))
(and (stringp docstring)
@@ -2242,8 +2234,8 @@ definition (see the code for `documentation')."
;; representations, so cache entries preactivated with version
;; 1 can't be used.
(cond
- ((ad-macro-p definition) 'macro2)
- ((ad-subr-p definition) 'subr2)
+ ((macrop definition) 'macro2)
+ ((subrp definition) 'subr2)
((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2)
((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen?
@@ -2273,7 +2265,7 @@ For that it has to be fbound with a non-autoload definition."
"True if FUNCTION has an interpreted definition that can be compiled."
(and (ad-has-proper-definition function)
(or (ad-lambda-p (symbol-function function))
- (ad-macro-p (symbol-function function)))
+ (macrop (symbol-function function)))
(not (ad-compiled-p (symbol-function function)))))
(defvar warning-suppress-types) ;From warnings.el.
@@ -2902,7 +2894,7 @@ If COMPILE is nil then the result depends on the value of
((eq ad-default-compilation-action 'never) nil)
((eq ad-default-compilation-action 'always) t)
((eq ad-default-compilation-action 'like-original)
- (or (ad-subr-p (ad-get-orig-definition function))
+ (or (subrp (ad-get-orig-definition function))
(ad-compiled-p (ad-get-orig-definition function))))
;; everything else means `maybe':
(t (featurep 'byte-compile))))
@@ -3249,7 +3241,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
`((ad-set-cache
',function
;; the function will get compiled:
- ,(cond ((ad-macro-p (car preactivation))
+ ,(cond ((macrop (car preactivation))
`(ad-macrofy
(function
,(ad-lambdafy
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index ae20e5270e1..ac7e5f12a18 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -295,19 +295,6 @@ A lambda list keyword is a symbol that starts with `&'."
(eq (selected-window)
(next-window (next-window (selected-window))))))
-(defsubst edebug-lookup-function (object)
- (while (and (symbolp object) (fboundp object))
- (setq object (symbol-function object)))
- object)
-
-(defun edebug-macrop (object)
- "Return the macro named by OBJECT, or nil if it is not a macro."
- (setq object (edebug-lookup-function object))
- (if (and (listp object)
- (eq 'macro (car object))
- (functionp (cdr object)))
- object))
-
(defun edebug-sort-alist (alist function)
;; Return the ALIST sorted with comparison function FUNCTION.
;; This uses 'sort so the sorting is destructive.
@@ -1416,7 +1403,7 @@ expressions; a `progn' form will be returned enclosing these forms."
; but leave it in for compatibility.
))
;; No edebug-form-spec provided.
- ((edebug-macrop head)
+ ((macrop head)
(if edebug-eval-macro-args
(edebug-forms cursor)
(edebug-sexps cursor)))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 660eb0365ae..576e72088e9 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -314,9 +314,8 @@ of the piece of advice."
((special-form-p def)
;; Not worth the trouble trying to handle this, I think.
(error "Advice impossible: %S is a special form" symbol))
- ((and (symbolp def)
- (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
- (let ((newval (cons 'macro (cdr (indirect-function def)))))
+ ((and (symbolp def) (macrop def))
+ (let ((newval `(macro . ,(lambda (&rest r) (macroexpand `(,def . ,r))))))
(put symbol 'advice--saved-rewrite (cons def (cdr newval)))
newval))
;; `f' might be a pure (hence read-only) cons!
@@ -351,19 +350,7 @@ of the piece of advice."
(when (get symbol 'advice--saved-rewrite)
(put symbol 'advice--saved-rewrite nil))
(setq newdef (advice--normalize symbol newdef))
- (let* ((olddef (advice--strip-macro (symbol-function symbol)))
- (oldadv
- (cond
- ((null (get symbol 'advice--pending))
- (or olddef
- (progn
- (message "Delayed advice activation failed for %s: no data"
- symbol)
- nil)))
- ((or (not olddef) (autoloadp olddef))
- (get symbol 'advice--pending))
- (t (message "Dropping left-over advice--pending for %s" symbol)
- olddef))))
+ (let ((oldadv (advice--symbol-function symbol)))
(if (and newdef (not (autoloadp newdef)))
(let* ((snewdef (advice--strip-macro newdef))
(snewadv (advice--subst-main oldadv snewdef)))
@@ -383,7 +370,6 @@ is defined as a macro, alias, command, ..."
;; TODO:
;; - record the advice location, to display in describe-function.
;; - change all defadvice in lisp/**/*.el.
- ;; - rewrite advice.el on top of this.
;; - obsolete advice.el.
(let* ((f (symbol-function symbol))
(nf (advice--normalize symbol f)))
@@ -420,8 +406,7 @@ of the piece of advice."
((eq (car-safe f) 'macro) (cdr f))
(t (symbol-function symbol)))
function)
- (unless (advice--p
- (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
+ (unless (advice--p (advice--symbol-function symbol))
;; Not advised any more.
(remove-function (get symbol 'defalias-fset-function)
#'advice--defalias-fset)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 50c92518b02..eb2c7f002e8 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -353,23 +353,34 @@ MATCH is the pattern that needs to be matched, of the form:
(symbolp . numberp)
(symbolp . consp)
(symbolp . arrayp)
+ (symbolp . vectorp)
(symbolp . stringp)
(symbolp . byte-code-function-p)
(integerp . consp)
(integerp . arrayp)
+ (integerp . vectorp)
(integerp . stringp)
(integerp . byte-code-function-p)
(numberp . consp)
(numberp . arrayp)
+ (numberp . vectorp)
(numberp . stringp)
(numberp . byte-code-function-p)
(consp . arrayp)
+ (consp . vectorp)
(consp . stringp)
(consp . byte-code-function-p)
- (arrayp . stringp)
(arrayp . byte-code-function-p)
+ (vectorp . byte-code-function-p)
+ (stringp . vectorp)
(stringp . byte-code-function-p)))
+(defun pcase--mutually-exclusive-p (pred1 pred2)
+ (or (member (cons pred1 pred2)
+ pcase-mutually-exclusive-predicates)
+ (member (cons pred2 pred1)
+ pcase-mutually-exclusive-predicates)))
+
(defun pcase--split-match (sym splitter match)
(cond
((eq (car match) 'match)
@@ -433,10 +444,7 @@ MATCH is the pattern that needs to be matched, of the form:
;; A QPattern but not for a cons, can only go to the `else' side.
((eq (car-safe pat) '\`) '(:pcase--fail . nil))
((and (eq (car-safe pat) 'pred)
- (or (member (cons 'consp (cadr pat))
- pcase-mutually-exclusive-predicates)
- (member (cons (cadr pat) 'consp)
- pcase-mutually-exclusive-predicates)))
+ (pcase--mutually-exclusive-p #'consp (cadr pat)))
'(:pcase--fail . nil))))
(defun pcase--split-equal (elem pat)
@@ -496,11 +504,14 @@ MATCH is the pattern that needs to be matched, of the form:
(not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
((and (eq 'pred (car upat))
- (eq 'pred (car-safe pat))
- (or (member (cons (cadr upat) (cadr pat))
- pcase-mutually-exclusive-predicates)
- (member (cons (cadr pat) (cadr upat))
- pcase-mutually-exclusive-predicates)))
+ (let ((otherpred
+ (cond ((eq 'pred (car-safe pat)) (cadr pat))
+ ((not (eq '\` (car-safe pat))) nil)
+ ((consp (cadr pat)) #'consp)
+ ((vectorp (cadr pat)) #'vectorp)
+ ((byte-code-function-p (cadr pat))
+ #'byte-code-function-p))))
+ (pcase--mutually-exclusive-p (cadr upat) otherpred)))
'(:pcase--fail . nil))
((and (eq 'pred (car upat))
(eq '\` (car-safe pat))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 69dc6c76b41..ef8a53f3c0b 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -993,14 +993,6 @@ at the moment are:
,@commands
(eshell-debug-command ,(concat "done " (eval tag)) form))))
-(defsubst eshell-macrop (object)
- "Return t if OBJECT is a macro or nil otherwise."
- (and (symbolp object) (fboundp object)
- (setq object (indirect-function object))
- (listp object)
- (eq 'macro (car object))
- (functionp (cdr object))))
-
(defun eshell-do-eval (form &optional synchronous-p)
"Evaluate form, simplifying it as we go.
Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
@@ -1016,7 +1008,7 @@ be finished later after the completion of an asynchronous subprocess."
(setq form (cadr (cadr form))))
;; expand any macros directly into the form. This is done so that
;; we can modify any `let' forms to evaluate only once.
- (if (eshell-macrop (car form))
+ (if (macrop (car form))
(let ((exp (eshell-copy-tree (macroexpand form))))
(eshell-manipulate (format "expanding macro `%s'"
(symbol-name (car form)))
diff --git a/lisp/subr.el b/lisp/subr.el
index 3b85a9bedb0..bdeee677471 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2750,6 +2750,13 @@ Otherwise, return nil."
(setq object (indirect-function object t)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+(defun macrop (object)
+ "Non-nil if and only if OBJECT is a macro."
+ (let ((def (indirect-function object t)))
+ (when (consp def)
+ (or (eq 'macro (car def))
+ (and (eq 'autoload (car def)) (memq (nth 4 def) '(macro t)))))))
+
(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account."
(let ((raw-field (get-char-property (field-beginning pos) 'field)))
@@ -4050,10 +4057,14 @@ backwards ARG times if negative."
;;;; Text clones
-(defun text-clone-maintain (ol1 after beg end &optional _len)
+(defvar text-clone--maintaining nil)
+
+(defun text-clone--maintain (ol1 after beg end &optional _len)
"Propagate the changes made under the overlay OL1 to the other clones.
This is used on the `modification-hooks' property of text clones."
- (when (and after (not undo-in-progress) (overlay-start ol1))
+ (when (and after (not undo-in-progress)
+ (not text-clone--maintaining)
+ (overlay-start ol1))
(let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
(setq beg (max beg (+ (overlay-start ol1) margin)))
(setq end (min end (- (overlay-end ol1) margin)))
@@ -4084,7 +4095,7 @@ This is used on the `modification-hooks' property of text clones."
(tail (- (overlay-end ol1) end))
(str (buffer-substring beg end))
(nothing-left t)
- (inhibit-modification-hooks t))
+ (text-clone--maintaining t))
(dolist (ol2 (overlay-get ol1 'text-clones))
(let ((oe (overlay-end ol2)))
(unless (or (eq ol1 ol2) (null oe))
@@ -4095,7 +4106,7 @@ This is used on the `modification-hooks' property of text clones."
(unless (> mod-beg (point))
(save-excursion (insert str))
(delete-region mod-beg (point)))
- ;;(overlay-put ol2 'modification-hooks '(text-clone-maintain))
+ ;;(overlay-put ol2 'modification-hooks '(text-clone--maintain))
))))
(if nothing-left (delete-overlay ol1))))))))
@@ -4126,17 +4137,18 @@ clone should be incorporated in the clone."
(>= pt-end (point-max))
(>= start (point-max)))
0 1))
+ ;; FIXME: Reuse overlays at point to extend dups!
(ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
(ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
(dups (list ol1 ol2)))
- (overlay-put ol1 'modification-hooks '(text-clone-maintain))
+ (overlay-put ol1 'modification-hooks '(text-clone--maintain))
(when spreadp (overlay-put ol1 'text-clone-spreadp t))
(when syntax (overlay-put ol1 'text-clone-syntax syntax))
;;(overlay-put ol1 'face 'underline)
(overlay-put ol1 'evaporate t)
(overlay-put ol1 'text-clones dups)
;;
- (overlay-put ol2 'modification-hooks '(text-clone-maintain))
+ (overlay-put ol2 'modification-hooks '(text-clone--maintain))
(when spreadp (overlay-put ol2 'text-clone-spreadp t))
(when syntax (overlay-put ol2 'text-clone-syntax syntax))
;;(overlay-put ol2 'face 'underline)
diff --git a/test/ChangeLog b/test/ChangeLog
index 32fc077459b..d744a5c788d 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,9 @@
+2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/advice-tests.el (advice-tests-nadvice): Test removal
+ before definition.
+ (advice-tests-macroaliases): New test.
+
2013-08-04 Glenn Morris <rgm@gnu.org>
* automated/ert-tests.el: Disable failing test that no-one seems
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index 69c15e34ed0..424f447ae4b 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -25,7 +25,12 @@
(ert-deftest advice-tests-nadvice ()
"Test nadvice code."
+ (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+ (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 2)))
+ (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
(defun sm-test1 (x) (+ x 4))
+ (should (equal (sm-test1 6) 20))
+ (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 2)))
(should (equal (sm-test1 6) 10))
(advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
(should (equal (sm-test1 6) 50))
@@ -42,6 +47,18 @@
(defmacro sm-test3 (x) `(call-test3 ,x))
(should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))))
+(ert-deftest advice-tests-macroaliases ()
+ "Test nadvice code on aliases to macros."
+ (defmacro sm-test1 (a) `(list ',a))
+ (defalias 'sm-test1-alias 'sm-test1)
+ (should (equal (macroexpand '(sm-test1-alias 5)) '(list '5)))
+ (advice-add 'sm-test1-alias :around
+ (lambda (f &rest args) `(cons 1 ,(apply f args))))
+ (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list '5))))
+ (defmacro sm-test1 (a) `(list 0 ',a))
+ (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list 0 '5)))))
+
+
(ert-deftest advice-tests-advice ()
"Test advice code."
(defun sm-test2 (x) (+ x 4))