dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-04-23 15:41:34 +02:00
commit b910c4ac4e
1 changed files with 81 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

108
module/ice-9/boot-9.scm
View file

@ -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))