Mercurial > hg > xemacs-beta
comparison lisp/bytecomp.el @ 5106:8c3671b62dad
Remove #'byte-compile-compiled-obj-to-list, bytecomp.el
2010-03-06 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-compiled-obj-to-list):
Remove this function, printing a compiled object to a string and
then reading back a substring is senseless, just use the
compiled-function slot accessor functions.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 06 Mar 2010 13:44:39 +0000 |
| parents | 99f8ebc082d9 |
| children | 2e528066e2fc |
comparison
equal
deleted
inserted
replaced
| 5105:d76a51b29d91 | 5106:8c3671b62dad |
|---|---|
| 2245 | 2245 |
| 2246 (put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro) | 2246 (put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro) |
| 2247 (defun byte-compile-file-form-defmacro (form) | 2247 (defun byte-compile-file-form-defmacro (form) |
| 2248 (byte-compile-file-form-defmumble form t)) | 2248 (byte-compile-file-form-defmumble form t)) |
| 2249 | 2249 |
| 2250 (defun byte-compile-compiled-obj-to-list (obj) | |
| 2251 ;; #### this is fairly disgusting. Rewrite the code instead | |
| 2252 ;; so that it doesn't create compiled objects in the first place! | |
| 2253 ;; Much better than creating them and then "uncreating" them | |
| 2254 ;; like this. | |
| 2255 (read (concat "(" | |
| 2256 (substring (let ((print-readably t) | |
| 2257 (print-gensym | |
| 2258 (if (and byte-compile-print-gensym | |
| 2259 (not byte-compile-emacs19-compatibility)) | |
| 2260 '(t) nil)) | |
| 2261 (print-gensym-alist nil)) | |
| 2262 (prin1-to-string obj)) | |
| 2263 2 -1) | |
| 2264 ")"))) | |
| 2265 | |
| 2266 (defun byte-compile-file-form-defmumble (form macrop) | 2250 (defun byte-compile-file-form-defmumble (form macrop) |
| 2267 (let* ((name (car (cdr form))) | 2251 (let* ((name (car (cdr form))) |
| 2268 (this-kind (if macrop 'byte-compile-macro-environment | 2252 (this-kind (if macrop 'byte-compile-macro-environment |
| 2269 'byte-compile-function-environment)) | 2253 'byte-compile-function-environment)) |
| 2270 (that-kind (if macrop 'byte-compile-function-environment | 2254 (that-kind (if macrop 'byte-compile-function-environment |
| 2328 (car-safe (cdr-safe body)) | 2312 (car-safe (cdr-safe body)) |
| 2329 (stringp (car-safe (cdr-safe (cdr-safe body))))) | 2313 (stringp (car-safe (cdr-safe (cdr-safe body))))) |
| 2330 (byte-compile-warn "Probable `\"' without `\\' in doc string of %s" | 2314 (byte-compile-warn "Probable `\"' without `\\' in doc string of %s" |
| 2331 (nth 1 form)))) | 2315 (nth 1 form)))) |
| 2332 (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) | 2316 (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) |
| 2333 (code (byte-compile-byte-code-maker new-one))) | 2317 (code (byte-compile-byte-code-maker new-one)) |
| 2318 (docform-info | |
| 2319 (cond ((atom code) ; compiled-function-p | |
| 2320 (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) | |
| 2321 ((eq (car code) 'quote) | |
| 2322 (setq code new-one) | |
| 2323 (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) | |
| 2324 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))))) | |
| 2334 (if this-one | 2325 (if this-one |
| 2335 (setcdr this-one new-one) | 2326 (setcdr this-one new-one) |
| 2336 (set this-kind | 2327 (set this-kind |
| 2337 (cons (cons name new-one) (symbol-value this-kind)))) | 2328 (cons (cons name new-one) (symbol-value this-kind)))) |
| 2338 (if (and (stringp (nth 3 form)) | 2329 (if (and (stringp (nth 3 form)) |
| 2339 (eq 'quote (car-safe code)) | 2330 (eq 'quote (car-safe code)) |
| 2340 (eq 'lambda (car-safe (nth 1 code)))) | 2331 (eq 'lambda (car-safe (nth 1 code)))) |
| 2341 (cons (car form) | 2332 (cons (car form) |
| 2342 (cons name (cdr (nth 1 code)))) | 2333 (cons name (cdr (nth 1 code)))) |
| 2343 (byte-compile-flush-pending) | 2334 (byte-compile-flush-pending) |
| 2344 (if (not (stringp (nth 3 form))) | 2335 (if (not (stringp (nth 3 form))) |
| 2345 ;; No doc string. Provide -1 as the "doc string index" | 2336 ;; No doc string. Provide -1 as the "doc string index" so that |
| 2346 ;; so that no element will be treated as a doc string. | 2337 ;; no element will be treated as a doc string by |
| 2347 (byte-compile-output-docform | 2338 ;; byte-compile-output-doc-form. |
| 2348 "\n(defalias '" | 2339 (setq docform-info (list (first docform-info) -1 |
| 2349 name | 2340 (third docform-info)))) |
| 2350 (cond ((atom code) | 2341 (byte-compile-output-docform |
| 2351 (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) | 2342 "\n(defalias '" |
| 2352 ((eq (car code) 'quote) | 2343 name |
| 2353 (setq code new-one) | 2344 docform-info |
| 2354 (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) | 2345 ;; The result of byte-compile-byte-code-maker is either a |
| 2355 ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) | 2346 ;; compiled-function object, or a list of some kind. If it's not a |
| 2356 ;; FSF just calls `(append code nil)' here but that relies | 2347 ;; cons, we must coerce it into a list of the elements to be |
| 2357 ;; on horrible C kludges in concat() that accept byte- | 2348 ;; printed to the file. |
| 2358 ;; compiled objects and pretend they're vectors. | 2349 (if (consp code) |
| 2359 (if (compiled-function-p code) | 2350 code |
| 2360 (byte-compile-compiled-obj-to-list code) | 2351 (nconc (list |
| 2361 (append code nil)) | 2352 (compiled-function-arglist code) |
| 2362 (and (atom code) byte-compile-dynamic | 2353 (compiled-function-instructions code) |
| 2363 1) | 2354 (compiled-function-constants code) |
| 2364 nil) | 2355 (compiled-function-stack-depth code) |
| 2365 ;; Output the form by hand, that's much simpler than having | 2356 (compiled-function-doc-string code)) |
| 2366 ;; b-c-output-file-form analyze the defalias. | 2357 (if (commandp code) |
| 2367 (byte-compile-output-docform | 2358 (list (nth 1 (compiled-function-interactive code)))))) |
| 2368 "\n(defalias '" | 2359 (and (atom code) byte-compile-dynamic |
| 2369 name | 2360 1) |
| 2370 (cond ((atom code) ; compiled-function-p | |
| 2371 (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) | |
| 2372 ((eq (car code) 'quote) | |
| 2373 (setq code new-one) | |
| 2374 (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) | |
| 2375 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) | |
| 2376 ;; The result of byte-compile-byte-code-maker is either a | |
| 2377 ;; compiled-function object, or a list of some kind. If it's | |
| 2378 ;; not a cons, we must coerce it into a list of the elements | |
| 2379 ;; to be printed to the file. | |
| 2380 (if (consp code) | |
| 2381 code | |
| 2382 (nconc (list | |
| 2383 (compiled-function-arglist code) | |
| 2384 (compiled-function-instructions code) | |
| 2385 (compiled-function-constants code) | |
| 2386 (compiled-function-stack-depth code)) | |
| 2387 (let ((doc (documentation code t))) | |
| 2388 (if doc (list doc))) | |
| 2389 (if (commandp code) | |
| 2390 (list (nth 1 (compiled-function-interactive code)))))) | |
| 2391 (and (atom code) byte-compile-dynamic | |
| 2392 1) | |
| 2393 nil)) | 2361 nil)) |
| 2394 (princ ")" byte-compile-outbuffer) | 2362 (princ ")" byte-compile-outbuffer) |
| 2395 nil)))) | 2363 nil))) |
| 2396 | 2364 |
| 2397 ;; Print Lisp object EXP in the output file, inside a comment, | 2365 ;; Print Lisp object EXP in the output file, inside a comment, |
| 2398 ;; and return the file position it will have. | 2366 ;; and return the file position it will have. |
| 2399 ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. | 2367 ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. |
| 2400 (defun byte-compile-output-as-comment (exp quoted) | 2368 (defun byte-compile-output-as-comment (exp quoted) |