mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Current module support hack.

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-03 22:14:41 +00:00
parent 437a31f454
commit fdcedea643
3 changed files with 18 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/language/r5rs/expand.scm
View file

@ -18,7 +18,7 @@
(define-module (language r5rs expand) (define-module (language r5rs expand)
:export (expand :export (expand void
identifier? free-identifier=? bound-identifier=? identifier? free-identifier=? bound-identifier=?
generate-temporaries datum->syntax-object syntax-object->datum)) generate-temporaries datum->syntax-object syntax-object->datum))

8
module/system/vm/assemble.scm
View file

@ -122,9 +122,9 @@
(let ((mod (make-vmod module))) (let ((mod (make-vmod module)))
(if toplevel (if toplevel
(begin (begin
(push-code! `(load-module ,module)) ;; (push-code! `(load-module ,module))
(push-code! `(load-symbol ,name)) (push-code! `(load-symbol ,name))
(push-code! `(link))) (push-code! `(link/current-module)))
(let ((vlink (make-vlink mod name))) (let ((vlink (make-vlink mod name)))
(push-code! `(object-ref ,(object-index vlink))))) (push-code! `(object-ref ,(object-index vlink)))))
(push-code! (list (symbol-append 'variable- op))))) (push-code! (list (symbol-append 'variable- op)))))
@ -212,9 +212,9 @@
(let dump! ((x (car obj+index))) (let dump! ((x (car obj+index)))
(cond (cond
((vlink? x) ((vlink? x)
(push-code! `(local-ref ,(object-index (vlink-module x)))) ;; (push-code! `(local-ref ,(object-index (vlink-module x))))
(push-code! `(load-symbol ,(vlink-name x))) (push-code! `(load-symbol ,(vlink-name x)))
(push-code! `(link))) (push-code! `(link/current-module)))
((vmod? x) ((vmod? x)
(push-code! `(load-module ,(vmod-id x)))) (push-code! `(load-module ,(vmod-id x))))
(else (else

13
src/vm_loader.c
View file

@ -126,6 +126,19 @@ VM_DEFINE_INSTRUCTION (link, "link", 0)
NEXT; NEXT;
} }
VM_DEFINE_INSTRUCTION (link_current_module, "link/current-module", 0)
{
SCM mod = scm_current_module ();
SCM var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
*sp, SCM_BOOL_F);
if (SCM_FALSEP (var))
/* Create a new variable if not defined yet */
var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
*sp, SCM_BOOL_T);
*sp = SCM_VARVCELL (var);
NEXT;
}
/* /*
Local Variables: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"