Introducción
La idea es contar cuántas veces aparece cada función en el bytecode de el código compilado Racket (versión 5.3.6) .Al compilar un programa de Racket, se realizan automáticamente varios pasos. Primero se expanden todas las macros, después se compila a un bytecode específico que se optimiza y el resultado se guarda en un archivo .zo. La optimización incluye propagación de constantes, enlineado de funciones (incluso funciones definidas en otros módulos) y muchas cosas más. Así que entre el programa original y la versión compilada a bytecode la diferencia es muy grande. Las funciones pueden ser primitivas (definidas en C) ó estar definidas en otros módulos.
Las funciones se pueden asignar a variables o pasar como parámetros a otras funciones. Vamos a contar solamente cuántas veces aparece cada función en la posición de aplicación directa. Por ejemplo en (zero? (+ 1 2)) vamos a contar a zero? y a +, pero en (cons 'sum +) sólo vamos a contar cons, pero no +.
Además vamos a ignorar las aplicaciones de funciones que son argumentos de otras funciones, por ejemplo en (define (apply-to-random f) (f (random))) vamos a ignorar f. Aunque es probable que este código sea enlineado por el optimizador y si calculamos (apply-to-random add1) va a quedar (add1 (random)) y en ese caso vamos a contar add1.
Este es un recuento estático de cuántas veces aparece cada función, la cantidad de llamadas a cada función al ejecutarse puede ser muy distinta.
Resultados
En el directorio de Racket (versión 5.3.6) hay 4575 archivos .zo y 3145659 llamadas a funciones. Cada archivo tiene en promedio a 688 llamadas a funciones.| Llamadas |
Funciones Distintas | Llamadas por Función | Llamadas por Archivo | |||
|---|---|---|---|---|---|---|
| Prim | 2042289 | 65% | 1033 | 4% | 1977 | 446 |
| NoPrim | 1103370 | 35% | 23992 | 96% | 46 | 241 |
| Total | 3145659 | 25025 | 126 | 688 |
Al contar las funciones obtuvimos los siguientes resultados. Las funciones no-primitivas están en itálica.
| Pos | Cantidad | Nombre | Prim | |
|---|---|---|---|---|
| 1 | 309802 | datum->syntax | #t | |
| 2 | 305884 | list | #t | |
| 3 | 118896 | cons | #t | |
| 4 | 96201 | unsafe-cdr | #t | |
| 5 | 91229 | null? | #t | |
| 6 | 81452 | car | #t | |
| 7 | 77059 | eq? | #t | |
| 8 | 71870 | unsafe-car | #t | |
| 9 | 62725 | _*keep-s-expr:p@(lib "scribble/private/manual-scheme.rkt") | #f | |
| 10 | 57761 | _to-element15.25:p@(lib "scribble/racket.rkt") | #f | |
| 11 | 45041 | vector | #t | |
| 12 | 42930 | syntax-e | #t | |
| 13 | 42924 | values | #t | |
| 14 | 42063 | pair? | #t | |
| 15 | 41244 | _to-paragraph31.31:p@(lib "scribble/racket.rkt") | #f | |
| 16 | 38956 | cdr | #t | |
| 17 | 36267 | _check-pre-part:P@(lib "scribble/doclang.rkt") | #f | |
| 18 | 30222 | + | #t | |
| 19 | 29284 | _find-method/who:p@(lib "racket/private/class-internal.rkt") | #f | |
| 20 | 26117 | _*Value:f@(lib "typed-racket/rep/type-rep.rkt") | #f | |
| 21 | 25417 | _make-var-id:mk@(lib "scribble/racket.rkt") | #f | |
| 22 | 22954 | _flat-named-contract:p@(lib "racket/contract/private/misc.rkt") | #f | |
| 23 | 19851 | vector-ref | #t | |
| 24 | 19697 | srcloc | #t | |
| 25 | 18502 | list? | #t |
{define-syntax-rule (repeat n
body ...)
(for ([i (in-range n)])
body ...)}
se obtiene una versión expandida que usa funciones primitivas como
datum->syntax y mucho manejo de la expresión como lista. Supongo que esto de
debe a que estamos analizando el código que define a Racket a partir de una
versión más simplificada de Racket y por ello usa muchas macros. En el código
también hay varios lenguajes adicionales construidos a partir de Racket, lo que
agrega más macros. Supongo que el código normal tiene usualmente menos macros.Para ver el recuento de todas las funciones, podemos ordenarlas desde la más frecuente a la menos frecuente y graficar la cantidad de veces que aparece cada una. Para poder ver el comportamiento general con claridad, usamos ejes logarítmicos en ambas escalas. En esta escala las líneas rectas representan funciones del tipo xk.
Vemos que el único salto grande es entre las primeras dos funciones y el resto, el x3 corresponde a media graduación de la escala. Las funciones primitivas y las no primitivas están bastante intercaladas, aunque hay muchas no primitivas que aparecen una sola vez.
Podemos dividirlo en dos grupos. La cantidad de apariciones de las primera 100 sigue una formula de la forma x-0,997. En cambio las otras siguen una formula de la forma x-1,53. Los coeficientes son aproximadamente -1,0 y -1,5. Parece haber algún cambio en el comportamiento en ese punto, pero no se a que se debe. Es posible que sea sólo numerología y una aplicación directa de la ley de Mar: Todo es lineal si se grafica en coordenadas log-log con un marcador bien grueso. Mi corolario es: Es más fácil con dos marcadores.
Modificando decompile
El bytecode se puede ver en un formato casi leíble por humanos usando decopile. En realidad no es una traducción directa, porque algunas de las instrucciones del bytecode no tienen una representación directa en Racket. No hay que tomarlo como algo literal, pero en general es entendible y da una buena idea de qué es lo que se optimizó y qué es lo que quedó.Esto es muy parecido a lo que queremos hacer, así que simplemente tomamos el código fuente de decompile, cambiamos todos los decompile por explore y empezamos a hacer cambios. Por ejemplo:
- No necesitamos ver que hay en los require y provide, porque sólo sirven para conectar las funciones de un módulo con las de otro módulo, no ejecutan código.
- No necesitamos ver que hay adentro de las syntax, porque tienen sólo datos que se usa para generar nuevo código en las macros.
- Algunas funciones tienen dos versiones, una para ejecutar y otra para enlinear. Ignoramos la versión para enlinear.
- Ignoramos los valores directos como números, #f y #t, cadenas de texto, quote.
- No hace falta devolver ningún resultado, así que eliminamos las listas que representan el código decompilado.
- expr es la expresión a analizar.
- glob tiene alguna definiciones globales, por ejemplo las variables (y funciones) definidas globalmente y en otros módulos.
- stack tiene las variables locales, corresponde más o menos a lo que se guarda usualmente en el stack
- closed tiene las funciones cerradas que ya fueron analizadas
{define (explore-expr expr globs stack closed); versión corta, con algunas omisiones.
(match expr
[(struct assign (id rhs undef-ok?))
(explore-expr rhs globs stack closed)]
[(? lam?)
(explore-lam expr globs stack closed)]
[(struct case-lam (name lams))
(for ([lam (in-list lams)])
(explore-lam lam globs stack closed))]
[(struct let-one (rhs body type unused?))
(let ([id (or (extract-id rhs) (gensym (or type (if unused? 'unused 'local))))])
(explore-expr rhs globs (cons id stack) closed)
(explore-expr body globs (cons id stack) closed))]
[(struct let-void (count boxes? body))
(let ([ids (extract-ids body count)])
(let ([vars (for/list ([id (in-list ids)])
(or id (gensym (if boxes? 'localvb 'localv))))])
(explore-expr body globs (append vars stack) closed)))]
[(struct let-rec (procs body))
(begin
(for ([proc (in-list procs)])
(explore-expr proc globs stack closed))
(explore-expr body globs stack closed))]
[(struct install-value (count pos boxes? rhs body))
(begin
(explore-expr rhs globs stack closed)
(explore-expr body globs stack closed))]
[(struct boxenv (pos body))
(explore-expr body globs stack closed)]
[(struct branch (test then else))
(begin
(explore-expr test globs stack closed)
(explore-expr then globs stack closed)
(explore-expr else globs stack closed))]
[(struct application (rator rands))
(let ([vars (for/list ([i (in-list rands)]) (gensym 'rand))])
(explore-var rator globs (append vars stack) closed)
(explore-expr rator globs (append vars stack) closed)
(for ([rand (in-list rands)])
(explore-expr rand globs (append vars stack) closed)))]
[(struct apply-values (proc args-expr))
(begin
(explore-var proc globs stack closed)
(explore-expr proc globs stack closed)
(explore-expr args-expr globs stack closed))]
[(struct seq (exprs))
(for ([expr (in-list exprs)])
(explore-expr expr globs stack closed))]
[(struct beg0 (exprs))
(for ([expr (in-list exprs)])
(explore-expr expr globs stack closed))]
[(struct closure (lam gen-id))
(unless (hash-ref closed gen-id #f)
(hash-set! closed gen-id #t)
(explore-expr lam globs stack closed))]
[else (void)])}
Vamos así recorriendo recursivamente toda la estructura que representa el bytecode, hasta llegar a las aplicaciones de las
funciones (la versión normal y la de
apply-values). En esos dos casos llamamos a
una nueva función explore-var que calcula el nombre de la función y lo manda al
programo principal usando una función guardada en un parámetro.Los parámetros sirven para definir variables casi globales. En general es mejor devolver los resultados como el resultado de la función. En este caso me pareció mejor devolver el resultado por un parámetro porque los valores se obtenían en una función muy metida adentro de llamadas recursivas y no quería cambiar mucho los parámetros de estas funciones. Otra ventaja es que así se puede ir visualizando las variables a medida que se encuentran en vez de esperar hasta el final.
También así se puede cambiar la función que está en el parámetro, sin tener que modificar el código de explore. El código del parámetro es mucho más sencillo y no depende de los detalles internos del bytecode, por lo que al separarlos es más fácil concentrarse en sólo la visualización de los datos.
(define current-explore-found (make-parameter void))
{define (explore-var expr globs stack closed)
(let ([v (match expr
[(struct toplevel (depth pos const? ready?))
(list-ref/protect globs pos 'toplevel)]
[(struct primval (id))
(hash-ref primitive-table id {lambda () (error "unknown primitive")})]
[(struct localref (unbox? offset clear? other-clears? type))
(list-ref/protect stack offset 'localref)]
[else #f])])
((current-explore-found) v))}
Buscando los archivos .zo
El programa principal llama a estas funciones para que analicen cada archivo .zo.Primero definimos funciones auxiliares para encontrar el directorio de Racket y filtrar los archivos .zo.
#lang racket
(require compiler/decompile
compiler/zo-parse)
(require racket/match)
(require "explore.rkt")
{define (get-racket-directory)
(let-values ([(dir file must-be-dir?)
(split-path (find-system-path 'exec-file))])
dir)}
{define (zo-file? f)
(and (file-exists? f)
(filename-extension f)
(bytes=? (filename-extension f) #"zo"))}
Definimos un
hash para guardar los resultados y una función que
los guarda allí los
símbolos que van apareciendo, dejando sólo los interned para filtrar los
argumentos y variables locales. (define found (make-hasheq))
{define (count-founded v)
(when (and v (symbol-interned? v))
(hash-set! found v (add1 (hash-ref found v {lambda () #;(displayln v) 0})))
#;(displayln (list v (hash-ref found v))))}
Ahora combinamos todo, buscamos cada archivo lo analizamos.
(parameterize ([current-explore-found count-founded])
(for ([file (sequence-filter zo-file? (in-directory (get-racket-directory)))])
#;(newline)
(displayln file)
{define program-zo (let ([port (open-input-file file)])
(begin0
(zo-parse port)
(close-input-port port)))}
(explore program-zo)
#;(pretty-display (decompile program-zo))
#;(pretty-display program-zo)))
Al final ordena las los datos del hash y los muestra.
(newline) (newline) (for ([name/count (in-list (sort (hash->list found) > #:key cdr))]) (display (cdr name/count)) (display " ") (displayln (car name/count)))
Ideas
- Me gustaría analizar combinaciones de funciones. Por ejemplo, contar las expresiones de la forma (f (g ?)) ignorando el valor de ?. También combinaciones de formas especiales y funciones. Por ejemplo, en los if.
- Borré mucho del código de decompile, más que nada para poder concentrarme en entender la parte que me interesaba. Estaría bueno tener una versión que mantenga más de la información inicial, así al llegar a algún punto interesante poder ver la versión decompilada. (Debería modificar el módulo de decompile para que exporte las funciones auxiliares y ver bien que hacer con las funciones cerradas (que no son closures).
Código completo
Código completo del módulo explore.rkt que define explore. Es un poco largo. Está basado en el módulo de decompile.#lang racket/base
(require compiler/zo-parse
syntax/modcollapse
racket/port
racket/match
racket/list
racket/path)
(provide explore
current-explore-found)
;; ----------------------------------------
(define current-explore-found (make-parameter void))
;; ----------------------------------------
{define primitive-table
;; Figure out number-to-id mapping for kernel functions in `primitive'
(let ([bindings
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
(namespace-require ''#%kernel)
(namespace-require ''#%unsafe)
(namespace-require ''#%flfxnum)
(namespace-require ''#%extfl)
(namespace-require ''#%futures)
(for/list ([l (namespace-mapped-symbols)])
(cons l (with-handlers ([exn:fail? {lambda (x) #f}])
(compile l))))))]
[table (make-hash)])
(for ([b (in-list bindings)])
(let ([v (and (cdr b)
(zo-parse
(open-input-bytes
(with-output-to-bytes
{lambda () (write (cdr b))}))))])
(let ([n (match v
[(struct compilation-top (_ prefix (struct primval (n)))) n]
[else #f])])
(hash-set! table n (car b)))))
table)}
{define (list-ref/protect l pos who)
(list-ref l pos)
#;
(if (pos . < . (length l))
(list-ref l pos)
`(OUT-OF-BOUNDS ,who ,pos ,(length l) ,l))}
;; ----------------------------------------
;; Main entry:
{define (explore top)
(let ([stx-ht (make-hasheq)])
(match top
[(struct compilation-top (max-let-depth prefix form))
(let ([globs (explore-prefix prefix stx-ht)])
(explore-form form globs '(#%globals) (make-hasheq) stx-ht))]
[else (error 'explore "unrecognized: ~e" top)]))}
{define (explore-prefix a-prefix stx-ht)
(match a-prefix
[(struct prefix (num-lifts toplevels stxs))
(let ([lift-ids (for/list ([i (in-range num-lifts)])
(gensym 'lift))]
[stx-ids (map (lambda (i) (gensym 'stx))
stxs)])
(append
(map {lambda (tl)
(match tl
[#f '#%linkage]
[(? symbol?) (string->symbol (format "_~a" tl))]
[(struct global-bucket (name))
(string->symbol (format "_~a" name))]
[(struct module-variable (modidx sym pos phase constantness))
(if (and (module-path-index? modidx)
(let-values ([(n b) (module-path-index-split modidx)])
(and (not n) (not b))))
(string->symbol (format "_~a" sym))
(string->symbol (format "_~s~a@~s~a"
sym
(match constantness
['constant ":c"]
['fixed ":f"]
[(function-shape a pm?)
(if pm? ":P" ":p")]
[(struct-type-shape c) ":t"]
[(constructor-shape a) ":mk"]
[(predicate-shape) ":?"]
[(accessor-shape c) ":ref"]
[(mutator-shape c) ":set!"]
[else ""])
(mpi->string modidx)
(if (zero? phase)
""
(format "/~a" phase)))))]
[else (error 'explore-prefix "bad toplevel: ~e" tl)])}
toplevels)
stx-ids
(if (null? stx-ids) null '(#%stx-array))
lift-ids))]
[else (error 'explore-prefix "huh?: ~e" a-prefix)])}
{define (mpi->string modidx)
(cond
[(symbol? modidx) modidx]
[else
(collapse-module-path-index modidx (build-path
(or (current-load-relative-directory)
(current-directory))
"here.rkt"))])}
{define (explore-module mod-form orig-stack stx-ht mod-name)
(match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
max-let-depth dummy lang-info internal-context flags pre-submodules post-submodules))
(let ([globs (explore-prefix prefix stx-ht)]
[stack (append '(#%modvars) orig-stack)]
[closed (make-hasheq)])
`(,mod-name ,(if (symbol? name) name (last name)) ....
,@(if (null? flags) '() (list `(quote ,flags)))
,@(let ([l (apply
append
(for/list ([req (in-list requires)]
#:when (pair? (cdr req)))
(define l (for/list ([mpi (in-list (cdr req))])
(define p (mpi->string mpi))
(if (path? p)
(let ([d (current-load-relative-directory)])
(path->string (if d
(find-relative-path (simplify-path d #t)
(simplify-path p #f)
#:more-than-root? #t)
p)))
p)))
(if (eq? 0 (car req))
l
`((,@(case (car req)
[(#f) `(for-label)]
[(1) `(for-syntax)]
[else `(for-meta ,(car req))])
,@l)))))])
(if (null? l)
null
`((require ,@l))))
,@(for/list ([submod (in-list pre-submodules)])
(explore-module submod orig-stack stx-ht 'module))
,@(for/list ([b (in-list syntax-bodies)])
(let loop ([n (sub1 (car b))])
(if (zero? n)
(cons 'begin
(for/list ([form (in-list (cdr b))])
(explore-form form globs stack closed stx-ht)))
(list 'begin-for-syntax (loop (sub1 n))))))
,@(map {lambda (form)
(explore-form form globs stack closed stx-ht)}
body)
,@(for/list ([submod (in-list post-submodules)])
(explore-module submod orig-stack stx-ht 'module*))))]
[else (error 'explore-module "huh?: ~e" mod-form)])}
{define (explore-form form globs stack closed stx-ht)
(match form
[(? mod?)
(explore-module form stack stx-ht 'module)]
[(struct def-values (ids rhs))
(if (inline-variant? rhs)
(explore-expr (inline-variant-direct rhs) globs stack closed)
(explore-expr rhs globs stack closed))]
[(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
(let ([globs (explore-prefix prefix stx-ht)])
(explore-form rhs globs '(#%globals) closed stx-ht))]
[(struct seq-for-syntax (exprs prefix max-let-depth dummy))
(let ([globs (explore-prefix prefix stx-ht)])
(for/list ([rhs (in-list exprs)])
(explore-form rhs globs '(#%globals) closed stx-ht)))]
[(struct seq (forms))
(map {lambda (form)
(explore-form form globs stack closed stx-ht)}
forms)]
[(struct splice (forms))
(map {lambda (form)
(explore-form form globs stack closed stx-ht)}
forms)]
[(struct req (reqs dummy))
(void)]
[else
(explore-expr form globs stack closed)])}
{define (extract-name name)
(if (symbol? name)
(gensym name)
(if (vector? name)
(gensym (vector-ref name 0))
#f))}
{define (extract-id expr)
(match expr
[(struct lam (name flags num-params arg-types rest? closure-map closure-types tl-map max-let-depth body))
(extract-name name)]
[(struct case-lam (name lams))
(extract-name name)]
[(struct closure (lam gen-id))
(extract-id lam)]
[else #f])}
{define (extract-ids body count)
(define (extract-ids! body ids)
(match body
[(struct let-rec (procs body))
(for ([proc (in-list procs)]
[delta (in-naturals)])
(when (< -1 delta (vector-length ids))
(vector-set! ids delta (extract-id proc))))
(extract-ids! body ids)]
[(struct install-value (val-count pos boxes? rhs body))
(extract-ids! body ids)]
[(struct boxenv (pos body))
(extract-ids! body ids)]
[else #f]))
(define ids (make-vector count #f))
(extract-ids! body ids)
(vector->list ids)}
{define (explore-var expr globs stack closed)
(let ([v (match expr
[(struct toplevel (depth pos const? ready?))
(list-ref/protect globs pos 'toplevel)]
[(struct primval (id))
(hash-ref primitive-table id {lambda () (error "unknown primitive")})]
[(struct localref (unbox? offset clear? other-clears? type))
(list-ref/protect stack offset 'localref)]
[else #f])])
((current-explore-found) v))}
{define (explore-expr expr globs stack closed)
(match expr
[(struct assign (id rhs undef-ok?))
(explore-expr rhs globs stack closed)]
[(? lam?)
(explore-lam expr globs stack closed)]
[(struct case-lam (name lams))
(for ([lam (in-list lams)])
(explore-lam lam globs stack closed))]
[(struct let-one (rhs body type unused?))
(let ([id (or (extract-id rhs) (gensym (or type (if unused? 'unused 'local))))])
(explore-expr rhs globs (cons id stack) closed)
(explore-expr body globs (cons id stack) closed))]
[(struct let-void (count boxes? body))
(let ([ids (extract-ids body count)])
(let ([vars (for/list ([id (in-list ids)])
(or id (gensym (if boxes? 'localvb 'localv))))])
(explore-expr body globs (append vars stack) closed)))]
[(struct let-rec (procs body))
(begin
(for ([proc (in-list procs)])
(explore-expr proc globs stack closed))
(explore-expr body globs stack closed))]
[(struct install-value (count pos boxes? rhs body))
(begin
(explore-expr rhs globs stack closed)
(explore-expr body globs stack closed))]
[(struct boxenv (pos body))
(explore-expr body globs stack closed)]
[(struct branch (test then else))
(begin
(explore-expr test globs stack closed)
(explore-expr then globs stack closed)
(explore-expr else globs stack closed))]
[(struct application (rator rands))
(let ([vars (for/list ([i (in-list rands)]) (gensym 'rand))])
(explore-var rator globs (append vars stack) closed)
(explore-expr rator globs (append vars stack) closed)
(for ([rand (in-list rands)])
(explore-expr rand globs (append vars stack) closed)))]
[(struct apply-values (proc args-expr))
(begin
(explore-var proc globs stack closed)
(explore-expr proc globs stack closed)
(explore-expr args-expr globs stack closed))]
[(struct seq (exprs))
(for ([expr (in-list exprs)])
(explore-expr expr globs stack closed))]
[(struct beg0 (exprs))
(for ([expr (in-list exprs)])
(explore-expr expr globs stack closed))]
[(struct with-cont-mark (key val body))
(begin
(explore-expr key globs stack closed)
(explore-expr val globs stack closed)
(explore-expr body globs stack closed))]
[(struct closure (lam gen-id))
(unless (hash-ref closed gen-id #f)
(hash-set! closed gen-id #t)
(explore-expr lam globs stack closed))]
[else (void)])}
{define (explore-lam expr globs stack closed)
(match expr
[(struct closure (lam gen-id)) (explore-lam lam globs stack closed)]
[(struct lam (name flags num-params arg-types rest? closure-map closure-types tl-map max-let-depth body))
(let ([vars (for/list ([i (in-range num-params)]
[type (in-list arg-types)])
(gensym (format "~a~a-"
(case type
[(ref) "argbox"]
[(val) "arg"]
[else (format "arg~a" type)])
i)))]
[rest-vars (if rest? (list (gensym 'rest)) null)]
[captures (map {lambda (v)
(list-ref/protect stack v 'lam)}
(vector->list closure-map))])
(explore-expr body globs (append captures vars rest-vars) closed))])}
