mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-23 21:10:29 +02:00
* boot-9.scm: Name change: value-ref --> local-ref
resolved-ref --> nested-ref Motivation: conformance to the other dictionary operators: list-ref operates on list, vector-ref operates on vector, nested-ref operates on nested namespace, local-ref operates on the local nested namespace.
This commit is contained in:
parent
d942b907f4
commit
0dd5491c17
1 changed files with 24 additions and 24 deletions
|
@ -1788,7 +1788,7 @@
|
||||||
;;; Each variable name is a list of elements, looked up in successively nested
|
;;; Each variable name is a list of elements, looked up in successively nested
|
||||||
;;; modules.
|
;;; modules.
|
||||||
;;;
|
;;;
|
||||||
;;; (resolved-ref some-root-module '(foo bar baz))
|
;;; (nested-ref some-root-module '(foo bar baz))
|
||||||
;;; => <value of a variable named baz in the module bound to bar in
|
;;; => <value of a variable named baz in the module bound to bar in
|
||||||
;;; the module bound to foo in some-root-module>
|
;;; the module bound to foo in some-root-module>
|
||||||
;;;
|
;;;
|
||||||
|
@ -1798,23 +1798,23 @@
|
||||||
;;; ;; a-root is a module
|
;;; ;; a-root is a module
|
||||||
;;; ;; name is a list of symbols
|
;;; ;; name is a list of symbols
|
||||||
;;;
|
;;;
|
||||||
;;; resolved-ref a-root name
|
;;; nested-ref a-root name
|
||||||
;;; resolved-set! a-root name val
|
;;; nested-set! a-root name val
|
||||||
;;; resolved-define! a-root name val
|
;;; nested-define! a-root name val
|
||||||
;;; resolved-remove! a-root name
|
;;; nested-remove! a-root name
|
||||||
;;;
|
;;;
|
||||||
;;;
|
;;;
|
||||||
;;; (current-module) is a natural choice for a-root so for convenience there are
|
;;; (current-module) is a natural choice for a-root so for convenience there are
|
||||||
;;; also:
|
;;; also:
|
||||||
;;;
|
;;;
|
||||||
;;; value-ref name == resolved-ref (current-module) name
|
;;; local-ref name == nested-ref (current-module) name
|
||||||
;;; value-set! name val == resolved-set! (current-module) name val
|
;;; local-set! name val == nested-set! (current-module) name val
|
||||||
;;; value-define! name val == resolved-define! (current-module) name val
|
;;; local-define! name val == nested-define! (current-module) name val
|
||||||
;;; value-remove! name == resolved-remove! (current-module) name
|
;;; local-remove! name == nested-remove! (current-module) name
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
|
||||||
(define (resolved-ref root names)
|
(define (nested-ref root names)
|
||||||
(let loop ((cur root)
|
(let loop ((cur root)
|
||||||
(elts names))
|
(elts names))
|
||||||
(cond
|
(cond
|
||||||
|
@ -1822,31 +1822,31 @@
|
||||||
((not (module? cur)) #f)
|
((not (module? cur)) #f)
|
||||||
(else (loop (module-ref cur (car elts) #f) (cdr elts))))))
|
(else (loop (module-ref cur (car elts) #f) (cdr elts))))))
|
||||||
|
|
||||||
(define (resolved-set! root names val)
|
(define (nested-set! root names val)
|
||||||
(let loop ((cur root)
|
(let loop ((cur root)
|
||||||
(elts names))
|
(elts names))
|
||||||
(if (null? (cdr elts))
|
(if (null? (cdr elts))
|
||||||
(module-set! cur (car elts) val)
|
(module-set! cur (car elts) val)
|
||||||
(loop (module-ref cur (car elts)) (cdr elts)))))
|
(loop (module-ref cur (car elts)) (cdr elts)))))
|
||||||
|
|
||||||
(define (resolved-define! root names val)
|
(define (nested-define! root names val)
|
||||||
(let loop ((cur root)
|
(let loop ((cur root)
|
||||||
(elts names))
|
(elts names))
|
||||||
(if (null? (cdr elts))
|
(if (null? (cdr elts))
|
||||||
(module-define! cur (car elts) val)
|
(module-define! cur (car elts) val)
|
||||||
(loop (module-ref cur (car elts)) (cdr elts)))))
|
(loop (module-ref cur (car elts)) (cdr elts)))))
|
||||||
|
|
||||||
(define (resolved-remove! root names)
|
(define (nested-remove! root names)
|
||||||
(let loop ((cur root)
|
(let loop ((cur root)
|
||||||
(elts names))
|
(elts names))
|
||||||
(if (null? (cdr elts))
|
(if (null? (cdr elts))
|
||||||
(module-remove! cur (car elts))
|
(module-remove! cur (car elts))
|
||||||
(loop (module-ref cur (car elts)) (cdr elts)))))
|
(loop (module-ref cur (car elts)) (cdr elts)))))
|
||||||
|
|
||||||
(define (value-ref names) (resolved-ref (current-module) names))
|
(define (local-ref names) (nested-ref (current-module) names))
|
||||||
(define (value-set! names val) (resolved-set! (current-module) names val))
|
(define (local-set! names val) (nested-set! (current-module) names val))
|
||||||
(define (value-define names val) (resolved-define! (current-module) names val))
|
(define (local-define names val) (nested-define! (current-module) names val))
|
||||||
(define (value-remove names) (resolved-remove! (current-module) names))
|
(define (local-remove names) (nested-remove! (current-module) names))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1873,14 +1873,14 @@
|
||||||
(set-current-module the-root-module)
|
(set-current-module the-root-module)
|
||||||
|
|
||||||
(define app (make-module 31))
|
(define app (make-module 31))
|
||||||
(value-define '(app modules) (make-module 31))
|
(local-define '(app modules) (make-module 31))
|
||||||
(value-define '(app modules guile) the-root-module)
|
(local-define '(app modules guile) the-root-module)
|
||||||
|
|
||||||
;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
|
;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
|
||||||
|
|
||||||
(define (resolve-module name)
|
(define (resolve-module name)
|
||||||
(let ((full-name (append '(app modules) name)))
|
(let ((full-name (append '(app modules) name)))
|
||||||
(let ((already (value-ref full-name)))
|
(let ((already (local-ref full-name)))
|
||||||
(or already
|
(or already
|
||||||
(begin
|
(begin
|
||||||
(try-module-autoload name)
|
(try-module-autoload name)
|
||||||
|
@ -2903,7 +2903,7 @@
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define-public (local-definitions-in root names)
|
(define-public (local-definitions-in root names)
|
||||||
(let ((m (resolved-ref root names))
|
(let ((m (nested-ref root names))
|
||||||
(answer '()))
|
(answer '()))
|
||||||
(if (not (module? m))
|
(if (not (module? m))
|
||||||
(set! answer m)
|
(set! answer m)
|
||||||
|
@ -2911,7 +2911,7 @@
|
||||||
answer))
|
answer))
|
||||||
|
|
||||||
(define-public (definitions-in root names)
|
(define-public (definitions-in root names)
|
||||||
(let ((m (resolved-ref root names)))
|
(let ((m (nested-ref root names)))
|
||||||
(if (not (module? m))
|
(if (not (module? m))
|
||||||
m
|
m
|
||||||
(reduce union
|
(reduce union
|
||||||
|
@ -2934,10 +2934,10 @@
|
||||||
various-refs)
|
various-refs)
|
||||||
(local-definitions-in (current-module) (car various-refs)))))
|
(local-definitions-in (current-module) (car various-refs)))))
|
||||||
|
|
||||||
(define-public (recursive-value-define name value)
|
(define-public (recursive-local-define name value)
|
||||||
(let ((parent (reverse! (cdr (reverse name)))))
|
(let ((parent (reverse! (cdr (reverse name)))))
|
||||||
(and parent (make-modules-in (current-module) parent))
|
(and parent (make-modules-in (current-module) parent))
|
||||||
(value-define name value)))
|
(local-define name value)))
|
||||||
|
|
||||||
(define-module (ice-9 q))
|
(define-module (ice-9 q))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue