Mercurial > emacs
comparison lisp/emacs-lisp/profile.el @ 23394:25eb153a9d4c
(profile-fix-fun): If already profiled,
return DEF unchanged, not nil. Simplify.
| author | Karl Heuer <kwzh@gnu.org> |
|---|---|
| date | Wed, 07 Oct 1998 18:32:55 +0000 |
| parents | db005054f15d |
| children | 1cd5555e67a9 |
comparison
equal
deleted
inserted
replaced
| 23393:bcac7111042a | 23394:25eb153a9d4c |
|---|---|
| 267 (fset fun (profile-fix-fun fun def)))) | 267 (fset fun (profile-fix-fun fun def)))) |
| 268 | 268 |
| 269 (defun profile-fix-fun (fun def) | 269 (defun profile-fix-fun (fun def) |
| 270 "Take function FUN and return it fixed for profiling. | 270 "Take function FUN and return it fixed for profiling. |
| 271 DEF is (symbol-function FUN)." | 271 DEF is (symbol-function FUN)." |
| 272 (let (prefix first second third (count 2) inter suffix) | 272 (if (< (length def) 3) |
| 273 (if (< (length def) 3) | 273 def ; nothing to see |
| 274 nil ; nothing to see | 274 (let ((prefix (list (car def) (car (cdr def)))) |
| 275 (setq first (car def) second (car (cdr def)) | 275 (suffix (cdr (cdr def)))) |
| 276 third (car (nthcdr 2 def))) | |
| 277 (setq prefix (list first second)) | |
| 278 ;; Skip the doc string, if there is a string | 276 ;; Skip the doc string, if there is a string |
| 279 ;; which serves only as a doc string, | 277 ;; which serves only as a doc string, |
| 280 ;; and put it in PREFIX. | 278 ;; and put it in PREFIX. |
| 281 (if (or (not (stringp third)) (not (nthcdr 3 def))) | 279 (if (and (stringp (car suffix)) (cdr suffix)) |
| 282 ;; Either no doc string, or it is also the function value. | 280 (setq prefix (nconc prefix (list (car suffix))) |
| 283 (setq inter third) | 281 suffix (cdr suffix))) |
| 284 ;; Skip the doc string, | |
| 285 (setq count 3 | |
| 286 prefix (nconc prefix (list third)) | |
| 287 inter (car (nthcdr 3 def)))) | |
| 288 ;; Check for an interactive spec. | 282 ;; Check for an interactive spec. |
| 289 ;; If found, put it inu PREFIX and skip it. | 283 ;; If found, put it into PREFIX and skip it. |
| 290 (if (not (and (listp inter) | 284 (if (and (listp (car suffix)) |
| 291 (eq (car inter) 'interactive))) | 285 (eq (car (car suffix)) 'interactive)) |
| 292 nil | 286 (setq prefix (nconc prefix (list (car suffix))) |
| 293 (setq prefix (nconc prefix (list inter))) | 287 suffix (cdr suffix))) |
| 294 (setq count (1+ count))) ; skip this sexp for suffix | |
| 295 ;; Set SUFFIX to the function body forms. | |
| 296 (setq suffix (nthcdr count def)) | |
| 297 (if (equal (car suffix) '(profile-get-time)) | 288 (if (equal (car suffix) '(profile-get-time)) |
| 298 nil | 289 def ; already profiled |
| 299 ;; Prepare new function definition. | 290 ;; Prepare new function definition. |
| 300 (nconc prefix | 291 (nconc prefix |
| 301 (list '(profile-get-time)) ; read time | 292 (list '(profile-get-time) ; read time |
| 302 (list (list 'profile-start-function | 293 (list 'profile-start-function |
| 303 (list 'quote fun))) | 294 (list 'quote fun)) |
| 304 (list (list 'setq 'profile-temp-result- | 295 (list 'setq 'profile-temp-result- |
| 305 (nconc (list 'progn) suffix))) | 296 (cons 'progn suffix)) |
| 306 (list '(profile-get-time)) ; read time | 297 '(profile-get-time) ; read time |
| 307 (list (list 'profile-update-function | 298 (list 'profile-update-function |
| 308 (list 'quote fun))) | 299 (list 'quote fun)) |
| 309 (list 'profile-temp-result-) | 300 'profile-temp-result-)))))) |
| 310 ))))) | |
| 311 | 301 |
| 312 (defun profile-restore-fun (fun) | 302 (defun profile-restore-fun (fun) |
| 313 "Restore profiled function FUN to its original state." | 303 "Restore profiled function FUN to its original state." |
| 314 (let ((def (symbol-function (car fun))) body index) | 304 (let ((def (symbol-function (car fun))) body index) |
| 315 ;; move index beyond header | 305 ;; move index beyond header |