mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 09:40:25 +02:00
Code Activity

bind all module-level variables lazily

Browse source 
comments in ghil-lookup are pertinent.

* module/system/il/compile.scm (make-glil-var): Require that ghil vars
  have environments. Remove the 'unresolved case -- we'll treat all
  module-level variables as late bound.

* module/system/il/ghil.scm (ghil-lookup): Treat all module level vars as
  late bound.

* module/system/vm/assemble.scm: Instead of vlink and vlate-bound, have
  vlink-now and vlink-later.
  (codegen): Add a bunch of crap to get the various cases right.
  (object-assoc, dump-object!): Handle the new cases, remove the old
  cases.

* src/vm_loader.c (link-now, link-later): Change from link and lazy-bind.
  Include the module in which the link is to be done, so that callers
  from other modules get the right behavior.

* src/vm_system.c (late-variable-ref, late-variable-set): Instead of a
  sym, the unbound representation is a module name / symbol pair.

* testsuite/run-vm-tests.scm (run-vm-tests): Remove some debugging.
This commit is contained in:
Andy Wingo 2008-05-19 19:37:39 +02:00
parent 9cc649b880
commit 6297d22907
6 changed files with 72 additions and 86 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/system/il/compile.scm
View file

@ -101,10 +101,8 @@
(make-glil-external op depth (ghil-var-index var)))))
((module)
(let ((env (ghil-var-env var)))
(make-glil-module op (and env (ghil-mod-module (ghil-env-mod env)))
(make-glil-module op (ghil-mod-module (ghil-env-mod env))
(ghil-var-name var))))
((unresolved)
(make-glil-late-bound op (ghil-var-name var)))
(else (error "Unknown kind of variable:" var))))
(define (codegen ghil)

17
module/system/il/ghil.scm
View file

@ -185,11 +185,6 @@
;;; Public interface
;;;
(define (module-lookup module sym)
(let ((iface (module-import-interface module sym)))
(and iface
(make-ghil-env (make-ghil-mod iface)))))
(define (fix-ghil-mod! mod for-sym)
;;; So, these warnings happen for all instances of define-module.
;;; Rather than fixing the problem, I'm going to suppress the common
@ -219,13 +214,13 @@
(fix-ghil-mod! e sym)
(loop e))
((assq-ref table sym)) ;; when does this hit?
((module-lookup module sym)
=> (lambda (found-env)
(make-ghil-var found-env sym 'module)))
(else
;; a free variable that we have not resolved
(warn "unresolved variable during compilation:" sym)
(let ((var (make-ghil-var #f sym 'unresolved)))
;; although we could bind the variable here, in
;; practice further toplevel definitions in this
;; compilation unit could change how we would resolve
;; this binding, so punt and memoize the lookup at
;; runtime always.
(let ((var (make-ghil-var (make-ghil-env e) sym 'module)))
(apush! sym var table)
var))))
((<ghil-env> mod parent table variables)

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

@ -43,8 +43,8 @@
(define-record (<vm-asm> venv glil body))
(define-record (<venv> parent nexts closure?))
(define-record (<vmod> id))
(define-record (<vlink> module name))
(define-record (<vlate-bound> name))
(define-record (<vlink-now> module name))
(define-record (<vlink-later> module name))
(define-record (<vdefine> module name))
(define-record (<bytespec> vars bytes meta objs closure?))
@ -149,29 +149,28 @@
((<glil-module> op module name)
(case op
((ref)
(push-object! (make-vlink :module module :name name))
(push-code! '(variable-ref)))
((set)
(push-object! (make-vlink :module module :name name))
(push-code! '(variable-set)))
((ref set)
(cond
(toplevel
(push-object! (make-vlink-now :module module :name name))
(push-code! (case op
((ref) '(variable-ref))
((set) '(variable-set)))))
(else
(let* ((var (make-vlink-later :module module :name name))
(i (cond ((object-assoc var object-alist) => cdr)
(else
(let ((i (length object-alist)))
(set! object-alist (acons var i object-alist))
i)))))
(push-code! (case op
((ref) `(late-variable-ref ,i))
((set) `(late-variable-set ,i))))))))
((define)
(push-object! (make-vdefine :module module :name name))
(push-code! '(variable-set)))))
((<glil-late-bound> op name)
(let* ((var (make-vlate-bound :name name))
(i (cond ((object-assoc var object-alist) => cdr)
(else
(let ((i (length object-alist)))
(set! object-alist (acons var i object-alist))
i)))))
(case op
((ref)
(push-code! `(late-variable-ref ,i)))
((set)
(push-code! `(late-variable-set ,i)))
(else (error "unknown late bound" op name)))))
(push-code! '(variable-set)))
(else
(error "unknown toplevel var kind" op name))))
((<glil-label> label)
(set! label-alist (assq-set! label-alist label (current-address))))
@ -208,7 +207,8 @@
(define (object-assoc x alist)
(record-case x
((<vlink>) (assoc x alist))
((<vlink-now>) (assoc x alist))
((<vlink-later>) (assoc x alist))
(else (assq x alist))))
(define (stack->bytes stack label-alist)
@ -271,15 +271,17 @@
(if meta (dump! meta))
;; dump bytecode
(push-code! `(load-program ,bytes)))
((<vlink> module name)
(dump! (and=> module module-name))
((<vlink-later> module name)
(dump! (module-name module))
(dump! name)
(push-code! '(link)))
(push-code! '(link-later)))
((<vlink-now> module name)
(dump! (module-name module))
(dump! name)
(push-code! '(link-now)))
((<vdefine> module name)
;; FIXME: dump module
(push-code! `(define ,(symbol->string name))))
((<vlate-bound> name)
(push-code! `(late-bind ,(symbol->string name))))
((<vmod> id)
(push-code! `(load-module ,id)))
(else