mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-14 17:50:22 +02:00
Code Activity

prevent (resolve-module '(guile)) recursion

Browse source 
* ice-9/boot-9.scm (resolve-module): Change so that resolving '(guile)
  does not require any module lookups. This is so that while within a
  call to (resolve-module '(guile)), we don't recurse when looking up the
  location for e.g. `append'. I can imagine other ways to get around
  this, but this one seems OK.
This commit is contained in:
Andy Wingo 2008-09-02 00:40:57 -07:00
parent 3aabb7b793
commit 53f84bc8b5
1 changed files with 23 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

42
ice-9/boot-9.scm
View file

@ -1826,25 +1826,29 @@
;; NOTE: This binding is used in libguile/modules.c.
;;
(define (resolve-module name . maybe-autoload)
(let ((full-name (append '(%app modules) name)))
(let ((already (nested-ref the-root-module full-name)))
(if already
;; The module already exists...
(if (and (or (null? maybe-autoload) (car maybe-autoload))
(not (module-public-interface already)))
;; ...but we are told to load and it doesn't contain source, so
(begin
(try-load-module name)
already)
;; simply return it.
already)
(begin
;; Try to autoload it if we are told so
(if (or (null? maybe-autoload) (car maybe-autoload))
(try-load-module name))
;; Get/create it.
(make-modules-in (current-module) full-name))))))
(define resolve-module
(let ((the-root-module the-root-module))
(lambda (name . maybe-autoload)
(if (equal? name '(guile))
the-root-module
(let ((full-name (append '(%app modules) name)))
(let ((already (nested-ref the-root-module full-name)))
(if already
;; The module already exists...
(if (and (or (null? maybe-autoload) (car maybe-autoload))
(not (module-public-interface already)))
;; ...but we are told to load and it doesn't contain source, so
(begin
(try-load-module name)
already)
;; simply return it.
already)
(begin
;; Try to autoload it if we are told so
(if (or (null? maybe-autoload) (car maybe-autoload))
(try-load-module name))
;; Get/create it.
(make-modules-in (current-module) full-name)))))))))
;; Cheat. These bindings are needed by modules.c, but we don't want
;; to move their real definition here because that would be unnatural.