mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 13:00:26 +02:00
deprecate %app
* module/ice-9/boot-9.scm (module-name): Don't rely on (%app modules), use other tricks to name anonymous modules. (resolve-module): Instead of relying on %app, close over the root of the module hierarchy -- the module that was '(%app modules). * module/ice-9/deprecated.scm (%app): Provide a compatible %app shim.
This commit is contained in:
parent
bbd1d13333
commit
cb67c838f5
2 changed files with 43 additions and 50 deletions
|
@ -2139,22 +2139,13 @@ If there is no handler at all, Guile prints an error and then exits."
|
|||
|
||||
|
||||
|
||||
;;; {The (%app) module}
|
||||
;;; {The (guile) module}
|
||||
;;;
|
||||
;;; The root of conventionally named objects not directly in the top level.
|
||||
;;; The standard module, which has the core Guile bindings. Also called the
|
||||
;;; "root module", as it is imported by many other modules, but it is not
|
||||
;;; necessarily the root of anything; and indeed, the module named '() might be
|
||||
;;; better thought of as a root.
|
||||
;;;
|
||||
;;; (%app modules)
|
||||
;;; (%app modules guile)
|
||||
;;;
|
||||
;;; The directory of all modules and the standard root module.
|
||||
;;;
|
||||
|
||||
;; Define '(%app) and '(%app modules).
|
||||
(define %app (make-module 31))
|
||||
(set-module-name! %app '(%app))
|
||||
(let ((m (make-module 31)))
|
||||
(set-module-name! m '())
|
||||
(local-define '(%app modules) m))
|
||||
|
||||
;; module-public-interface is defined in C.
|
||||
(define (set-module-public-interface! m i)
|
||||
|
@ -2170,9 +2161,6 @@ If there is no handler at all, Guile prints an error and then exits."
|
|||
(set-system-module! the-root-module #t)
|
||||
(set-system-module! the-scm-module #t)
|
||||
|
||||
;; Define the-root-module as '(%app modules guile).
|
||||
(local-define '(%app modules guile) the-root-module)
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -2207,12 +2195,11 @@ If there is no handler at all, Guile prints an error and then exits."
|
|||
(lambda (mod)
|
||||
(or (accessor mod)
|
||||
(let ((name (list (gensym))))
|
||||
;; Name MOD and bind it in THE-ROOT-MODULE so that it's visible
|
||||
;; to `resolve-module'. This is important as `psyntax' stores
|
||||
;; module names and relies on being able to `resolve-module'
|
||||
;; them.
|
||||
;; Name MOD and bind it in the module root so that it's visible to
|
||||
;; `resolve-module'. This is important as `psyntax' stores module
|
||||
;; names and relies on being able to `resolve-module' them.
|
||||
(set-module-name! mod name)
|
||||
(nested-define! the-root-module `(%app modules ,@name) mod)
|
||||
(nested-define! (resolve-module '() #f) name mod)
|
||||
(accessor mod))))))
|
||||
|
||||
(define (make-modules-in module name)
|
||||
|
@ -2350,13 +2337,13 @@ If there is no handler at all, Guile prints an error and then exits."
|
|||
;; NOTE: This binding is used in libguile/modules.c.
|
||||
;;
|
||||
(define resolve-module
|
||||
(let ((the-root-module the-root-module))
|
||||
(let ((root (make-module)))
|
||||
(set-module-name! root '())
|
||||
;; Define the-root-module as '(guile).
|
||||
(module-define! root 'guile the-root-module)
|
||||
|
||||
(lambda (name . args) ;; #:optional (autoload #t) (version #f)
|
||||
(let ((full-name (append '(%app modules) name)))
|
||||
;; This is pretty strange that '(guile) is the same as '(guile %app
|
||||
;; modules guile), is the same as '(guile %app modules guile %app
|
||||
;; modules guile).
|
||||
(let* ((already (nested-ref the-root-module full-name))
|
||||
(let* ((already (nested-ref root name))
|
||||
(numargs (length args))
|
||||
(autoload (or (= numargs 0) (car args)))
|
||||
(version (and (> numargs 1) (cadr args))))
|
||||
|
@ -2376,9 +2363,8 @@ If there is no handler at all, Guile prints an error and then exits."
|
|||
;; A module is not bound (but maybe something else is),
|
||||
;; we're not autoloading -- here's the weird semantics,
|
||||
;; we create an empty module.
|
||||
(make-modules-in the-root-module full-name))))))))
|
||||
(make-modules-in root name)))))))
|
||||
|
||||
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
|
||||
|
||||
(define (try-load-module name version)
|
||||
(try-module-autoload name version))
|
||||
|
|
|
@ -39,6 +39,7 @@
|
|||
closure?
|
||||
%nil
|
||||
@bind
|
||||
%app
|
||||
app))
|
||||
|
||||
;;;; Deprecated definitions.
|
||||
|
@ -298,4 +299,10 @@
|
|||
(lambda ()
|
||||
(set! id old-v) ...)))))))))
|
||||
|
||||
;; Define (%app modules)
|
||||
(define %app (make-module 31))
|
||||
(set-module-name! %app '(%app))
|
||||
(nested-define! %app '(modules) (resolve-module '() #f))
|
||||
|
||||
;; app aliases %app
|
||||
(define app %app)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue