nested-ref et al use module-ref-submodule; add -module nested variants

* module/ice-9/boot-9.scm: Update comments above nested-ref to include
  ref-module and define-module!.
  (nested-ref, nested-set!, nested-define!, nested-remove!): Use
  module-ref-submodule to traverse the module hierarchy.
  (nested-ref-module, nested-define-module!): New functions, like
  nested-ref and nested-define!, but operate on namespaces instead of
  values.
  (local-ref-module, local-define-module): New analogs of local-ref and
  local-define, but for namespaces.

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 5f2da30..9fef3a7 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2084,15 +2084,15 @@ If there is no handler at all, Guile prints an error and then exits."
 ;;; {Recursive Namespaces}
 ;;;
 ;;; A hierarchical namespace emerges if we consider some module to be
-;;; root, and variables bound to modules as nested namespaces.
+;;; root, and submodules of that module to be nested namespaces.
 ;;;
-;;; The routines in this file manage variable names in hierarchical namespace.
+;;; The routines here manage variable names in hierarchical namespace.
 ;;; Each variable name is a list of elements, looked up in successively nested
 ;;; modules.
 ;;;
 ;;;             (nested-ref some-root-module '(foo bar baz))
-;;;             => <value of a variable named baz in the module bound to bar in
-;;;                 the module bound to foo in some-root-module>
+;;;             => <value of a variable named baz in the submodule bar of
+;;;                 the submodule foo of some-root-module>
 ;;;
 ;;;
 ;;; There are:
@@ -2105,50 +2105,104 @@ If there is no handler at all, Guile prints an error and then exits."
 ;;;     nested-define! a-root name val
 ;;;     nested-remove! a-root name
 ;;;
+;;; These functions manipulate values in namespaces. For referencing the
+;;; namespaces themselves, use the following:
 ;;;
-;;; (current-module) is a natural choice for a-root so for convenience there are
+;;;     nested-ref-module a-root name
+;;;     nested-define-module! a-root name mod
+;;;
+;;; (current-module) is a natural choice for a root so for convenience there are
 ;;; also:
 ;;;
-;;;     local-ref name          ==      nested-ref (current-module) name
-;;;     local-set! name val     ==      nested-set! (current-module) name val
-;;;     local-define name val   ==      nested-define! (current-module) name val
-;;;     local-remove name       ==      nested-remove! (current-module) name
+;;;     local-ref name                ==  nested-ref (current-module) name
+;;;     local-set! name val           ==  nested-set! (current-module) name val
+;;;     local-define name val         ==  nested-define! (current-module) name val
+;;;     local-remove name             ==  nested-remove! (current-module) name
+;;;     local-ref-module name         ==  nested-ref-module (current-module) name
+;;;     local-define-module! name m   ==  nested-define-module! (current-module) name m
 ;;;
 
 
 (define (nested-ref root names)
-  (let loop ((cur root)
-             (elts names))
-    (cond
-     ((null? elts)              cur)
-     ((not (module? cur))       #f)
-     (else (loop (module-ref cur (car elts) #f) (cdr elts))))))
+  (if (null? names)
+      root
+      (let loop ((cur root)
+                 (head (car names))
+                 (tail (cdr names)))
+        (if (null? tail)
+            (module-ref cur head #f)
+            (let ((cur (module-ref-submodule cur head)))
+              (and cur
+                   (loop cur (car tail) (cdr tail))))))))
 
 (define (nested-set! root names val)
   (let loop ((cur root)
-             (elts names))
-    (if (null? (cdr elts))
-        (module-set! cur (car elts) val)
-        (loop (module-ref cur (car elts)) (cdr elts)))))
+             (head (car names))
+             (tail (cdr names)))
+    (if (null? tail)
+        (module-set! cur head val)
+        (let ((cur (module-ref-submodule cur head)))
+          (if (not cur)
+              (error "failed to resolve module" names)
+              (loop cur (car tail) (cdr tail)))))))
 
 (define (nested-define! root names val)
   (let loop ((cur root)
-             (elts names))
-    (if (null? (cdr elts))
-        (module-define! cur (car elts) val)
-        (loop (module-ref cur (car elts)) (cdr elts)))))
+             (head (car names))
+             (tail (cdr names)))
+    (if (null? tail)
+        (module-define! cur head val)
+        (let ((cur (module-ref-submodule cur head)))
+          (if (not cur)
+              (error "failed to resolve module" names)
+              (loop cur (car tail) (cdr tail)))))))
 
 (define (nested-remove! root names)
   (let loop ((cur root)
-             (elts names))
-    (if (null? (cdr elts))
-        (module-remove! cur (car elts))
-        (loop (module-ref cur (car elts)) (cdr elts)))))
+             (head (car names))
+             (tail (cdr names)))
+    (if (null? tail)
+        (module-remove! cur head)
+        (let ((cur (module-ref-submodule cur head)))
+          (if (not cur)
+              (error "failed to resolve module" names)
+              (loop cur (car tail) (cdr tail)))))))
+
+
+(define (nested-ref-module root names)
+  (let loop ((cur root)
+             (names names))
+    (if (null? names)
+        cur
+        (let ((cur (module-ref-submodule cur (car names))))
+          (and cur
+               (loop cur (cdr names)))))))
+
+(define (nested-define-module! root names module)
+  (if (null? names)
+      (error "can't redefine root module" root module)
+      (let loop ((cur root)
+                 (head (car names))
+                 (tail (cdr names)))
+        (if (null? tail)
+            (module-define-submodule! cur head module)
+            (let ((cur (or (module-ref-submodule cur head)
+                           (let ((m (make-module 31)))
+                             (set-module-kind! m 'directory)
+                             (set-module-name! m (append (module-name cur)
+                                                         (list head)))
+                             (module-define-submodule! cur head m)
+                             m))))
+              (loop cur (car tail) (cdr tail)))))))
+
 
 (define (local-ref names) (nested-ref (current-module) names))
 (define (local-set! names val) (nested-set! (current-module) names val))
 (define (local-define names val) (nested-define! (current-module) names val))
 (define (local-remove names) (nested-remove! (current-module) names))
+(define (local-ref-module names) (nested-ref-module (current-module) names))
+(define (local-define-module names mod) (nested-define-module! (current-module) names mod))
+
 
 
 \f