mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

(language tree-il analyze) works better with RTL programs

Browse source 
* module/system/vm/program.scm (program-arguments-alists): Export this
  interface.  Fall back to grovelling through procedure-minimum-arity if
  the program has no arities, as might be the case for continuations.

* module/language/tree-il/analyze.scm (validate-arity): Use
  program-arguments-alists instead of the program-arities interface, to
  cover both stack VM and RTL programs.
This commit is contained in:
Andy Wingo 2013-10-18 18:41:59 +02:00
parent b0ca878cae
commit 8bd261baaa
2 changed files with 18 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -950,13 +950,15 @@ given `tree-il' element."
(or (and (or (null? x) (pair? x))
(length x))
0))
(cond ((program? proc)
(cond ((or (program? proc) (rtl-program? proc))
(values (procedure-name proc)
(map (lambda (a)
(list (arity:nreq a) (arity:nopt a) (arity:rest? a)
(map car (arity:kw a))
(arity:allow-other-keys? a)))
(program-arities proc))))
(list (length (or (assq-ref a 'required) '()))
(length (or (assq-ref a 'optional) '()))
(and (assq-ref a 'rest) #t)
(map car (or (assq-ref a 'keyword) '()))
(assq-ref a 'allow-other-keys?)))
(program-arguments-alists proc))))
((procedure? proc)
(if (struct? proc)
;; An applicable struct.

16
module/system/vm/program.scm
View file

@ -41,7 +41,8 @@
arity:nreq arity:nopt arity:rest? arity:kw arity:allow-other-keys?
program-arguments-alist program-lambda-list
program-arguments-alist program-arguments-alists
program-lambda-list
program-meta
program-objcode program? program-objects
@ -340,8 +341,9 @@
0)))
(define (program-arguments-alists prog)
(cond
((primitive? prog)
"Returns all arities of the given procedure, as a list of association
lists."
(define (fallback)
(match (procedure-minimum-arity prog)
(#f '())
((nreq nopt rest?)
@ -349,9 +351,13 @@
(arity->arguments-alist
prog
(list 0 0 nreq nopt rest? '(#f . ())))))))
(cond
((primitive? prog) (fallback))
((rtl-program? prog)
(map arity-arguments-alist
(or (find-program-arities (rtl-program-code prog)) '())))
(let ((arities (find-program-arities (rtl-program-code prog))))
(if arities
(map arity-arguments-alist arities)
(fallback))))
((program? prog)
(map (lambda (arity) (arity->arguments-alist prog arity))
(or (program-arities prog) '())))