mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

Add program-free-variables' to (system vm program)'.

Browse source 
* module/system/vm/program.scm (program-free-variables): New procedure.

* module/language/objcode/spec.scm (program-free-variables): Remove.
This commit is contained in:
Ludovic Courtès 2010-04-21 23:30:48 +02:00
parent e6bd58af8f
commit f9a86f72a6
2 changed files with 12 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/language/objcode/spec.scm
View file

@ -53,11 +53,6 @@
(lp (acons (binding:index b) (list b) ret)
(cdr locs))))))))
(define (program-free-variables program)
(list->vector
(map (lambda (i) (program-free-variable-ref program i))
(iota (program-num-free-variables program)))))
(define (decompile-value x env opts)
(cond
((program? x)

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

@ -20,7 +20,8 @@
(define-module (system vm program)
#:use-module (system base pmatch)
#:use-module (ice-9 optargs)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (make-program
make-binding binding:name binding:boxed? binding:index
@ -35,10 +36,11 @@
arity:nreq arity:nopt arity:rest? arity:kw arity:allow-other-keys?
program-arguments-alist program-lambda-list
program-meta
program-objcode program? program-objects
program-module program-base
program-free-variables
program-num-free-variables
program-free-variable-ref program-free-variable-set!))
@ -190,6 +192,14 @@
,@(if (pair? key) (cons #:key key) '())
. ,rest)))
(define (program-free-variables prog)
"Return the list of free variables of PROG."
(let ((count (program-num-free-variables prog)))
(unfold (lambda (i) (>= i count))
(cut program-free-variable-ref prog <>)
1+
0)))
(define (write-program prog port)
(format port "#<procedure ~a~a>"
(or (procedure-name prog)