mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 21:10:29 +02:00
Code Activity

Use vhashes in `arity-analysis'.

Browse source 
* module/language/tree-il/analyze.scm (arity-analysis): Use vhashes
  instead of alists.
This commit is contained in:
Ludovic Courtès 2010-02-03 00:00:05 +01:00
parent 04ea6fb504
commit df685ee46b
1 changed files with 39 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

31
module/language/tree-il/analyze.scm
View file

@ -1054,19 +1054,19 @@ accurate information is missing from a given `tree-il' element."
(record-case val (record-case val
((<lambda> body) ((<lambda> body)
(make-arity-info toplevel-calls (make-arity-info toplevel-calls
(alist-cons lexical-name val (vhash-consq lexical-name val
lexical-lambdas) lexical-lambdas)
toplevel-lambdas)) toplevel-lambdas))
((<lexical-ref> gensym) ((<lexical-ref> gensym)
;; lexical alias ;; lexical alias
(let ((val* (assq gensym lexical-lambdas))) (let ((val* (vhash-assq gensym lexical-lambdas)))
(if (pair? val*) (if (pair? val*)
(extend lexical-name (cdr val*) info) (extend lexical-name (cdr val*) info)
info))) info)))
((<toplevel-ref> name) ((<toplevel-ref> name)
;; top-level alias ;; top-level alias
(make-arity-info toplevel-calls (make-arity-info toplevel-calls
(alist-cons lexical-name val (vhash-consq lexical-name val
lexical-lambdas) lexical-lambdas)
toplevel-lambdas)) toplevel-lambdas))
(else info)))) (else info))))
@ -1081,13 +1081,13 @@ accurate information is missing from a given `tree-il' element."
((<lambda> body) ((<lambda> body)
(make-arity-info toplevel-calls (make-arity-info toplevel-calls
lexical-lambdas lexical-lambdas
(alist-cons name exp toplevel-lambdas))) (vhash-consq name exp toplevel-lambdas)))
((<toplevel-ref> name) ((<toplevel-ref> name)
;; alias for another toplevel ;; alias for another toplevel
(let ((proc (assq name toplevel-lambdas))) (let ((proc (vhash-assq name toplevel-lambdas)))
(make-arity-info toplevel-calls (make-arity-info toplevel-calls
lexical-lambdas lexical-lambdas
(alist-cons (toplevel-define-name x) (vhash-consq (toplevel-define-name x)
(if (pair? proc) (if (pair? proc)
(cdr proc) (cdr proc)
exp) exp)
@ -1106,16 +1106,16 @@ accurate information is missing from a given `tree-il' element."
(validate-arity proc x #t) (validate-arity proc x #t)
info) info)
((<toplevel-ref> name) ((<toplevel-ref> name)
(make-arity-info (alist-cons name x toplevel-calls) (make-arity-info (vhash-consq name x toplevel-calls)
lexical-lambdas lexical-lambdas
toplevel-lambdas)) toplevel-lambdas))
((<lexical-ref> gensym) ((<lexical-ref> gensym)
(let ((proc (assq gensym lexical-lambdas))) (let ((proc (vhash-assq gensym lexical-lambdas)))
(if (pair? proc) (if (pair? proc)
(record-case (cdr proc) (record-case (cdr proc)
((<toplevel-ref> name) ((<toplevel-ref> name)
;; alias to toplevel ;; alias to toplevel
(make-arity-info (alist-cons name x toplevel-calls) (make-arity-info (vhash-consq name x toplevel-calls)
lexical-lambdas lexical-lambdas
toplevel-lambdas)) toplevel-lambdas))
(else (else
@ -1136,7 +1136,9 @@ accurate information is missing from a given `tree-il' element."
(lexical-lambdas (lexical-lambdas info)) (lexical-lambdas (lexical-lambdas info))
(toplevel-lambdas (toplevel-lambdas info))) (toplevel-lambdas (toplevel-lambdas info)))
(make-arity-info toplevel-calls (make-arity-info toplevel-calls
(alist-delete name lexical-lambdas eq?) (if (vhash-assq name lexical-lambdas)
(vlist-tail lexical-lambdas)
lexical-lambdas)
toplevel-lambdas))) toplevel-lambdas)))
(let ((toplevel-calls (toplevel-procedure-calls info)) (let ((toplevel-calls (toplevel-procedure-calls info))
@ -1157,11 +1159,12 @@ accurate information is missing from a given `tree-il' element."
;; encountered. ;; encountered.
(let ((toplevel-calls (toplevel-procedure-calls result)) (let ((toplevel-calls (toplevel-procedure-calls result))
(toplevel-lambdas (toplevel-lambdas result))) (toplevel-lambdas (toplevel-lambdas result)))
(for-each (lambda (name+application) (vlist-for-each
(lambda (name+application)
(let* ((name (car name+application)) (let* ((name (car name+application))
(application (cdr name+application)) (application (cdr name+application))
(proc (proc
(or (assoc-ref toplevel-lambdas name) (or (and=> (vhash-assq name toplevel-lambdas) cdr)
(and (module? env) (and (module? env)
(false-if-exception (false-if-exception
(module-ref env name))))) (module-ref env name)))))
@ -1173,10 +1176,8 @@ accurate information is missing from a given `tree-il' element."
(false-if-exception (false-if-exception
(module-ref env name)))) (module-ref env name))))
proc))) proc)))
;; (format #t "toplevel-call to ~A (~A) from ~A~%"
;; name proc* application)
(if (or (lambda? proc*) (procedure? proc*)) (if (or (lambda? proc*) (procedure? proc*))
(validate-arity proc* application (lambda? proc*))))) (validate-arity proc* application (lambda? proc*)))))
toplevel-calls))) toplevel-calls)))
(make-arity-info '() '() '()))) (make-arity-info vlist-null vlist-null vlist-null)))