1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00

Favor docstrings for describing the purpose of functions.

* module/ice-9/boot-9.scm: Where functions have docstring-style
  comments, make them proper docstrings.
This commit is contained in:
Wilfred Hughes 2016-09-05 22:23:13 -04:00 committed by Andy Wingo
parent 62f08b8f38
commit 67b8b6fb06

View file

@ -168,16 +168,13 @@ a-cont
;;; {Simple Debugging Tools} ;;; {Simple Debugging Tools}
;;; ;;;
;; peek takes any number of arguments, writes them to the
;; current ouput port, and returns the last argument.
;; It is handy to wrap around an expression to look at
;; a value each time is evaluated, e.g.:
;;
;; (+ 10 (troublesome-fn))
;; => (+ 10 (pk 'troublesome-fn-returned (troublesome-fn)))
;;
(define (peek . stuff) (define (peek . stuff)
"Write arguments to the current output port, and return the last argument.
This is handy for tracing function calls, e.g.:
(+ 10 (troublesome-fn))
=> (+ 10 (pk 'troublesome-fn-returned (troublesome-fn)))"
(newline) (newline)
(display ";;; ") (display ";;; ")
(write stuff) (write stuff)
@ -202,11 +199,11 @@ a-cont
(if (not (memq sym *features*)) (if (not (memq sym *features*))
(set! *features* (cons sym *features*)))) (set! *features* (cons sym *features*))))
;; Return #t iff FEATURE is available to this Guile interpreter. In SLIB, ;; In SLIB, provided? also checks to see if the module is available. We
;; provided? also checks to see if the module is available. We should do that ;; should do that too, but don't.
;; too, but don't.
(define (provided? feature) (define (provided? feature)
"Return #t iff FEATURE is available to this Guile interpreter."
(and (memq feature *features*) #t)) (and (memq feature *features*) #t))
@ -308,13 +305,10 @@ a-cont
;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...) ;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
;;; ;;;
;; and-map f l
;;
;; Apply f to successive elements of l until exhaustion or f returns #f.
;; If returning early, return #f. Otherwise, return the last value returned
;; by f. If f has never been called because l is empty, return #t.
;;
(define (and-map f lst) (define (and-map f lst)
"Apply F to successive elements of LST until exhaustion or F returns #f.
If returning early, return #f. Otherwise, return the last value returned
by F. If F has never been called because LST is empty, return #t."
(let loop ((result #t) (let loop ((result #t)
(l lst)) (l lst))
(and result (and result
@ -322,12 +316,9 @@ a-cont
result) result)
(loop (f (car l)) (cdr l)))))) (loop (f (car l)) (cdr l))))))
;; or-map f l
;;
;; Apply f to successive elements of l until exhaustion or while f returns #f.
;; If returning early, return the return value of f.
;;
(define (or-map f lst) (define (or-map f lst)
"Apply F to successive elements of LST until exhaustion or while F returns #f.
If returning early, return the return value of F."
(let loop ((result #f) (let loop ((result #f)
(l lst)) (l lst))
(or result (or result
@ -362,9 +353,8 @@ a-cont
(char_pred (string-ref s (1- end)))) (char_pred (string-ref s (1- end))))
(string-every-c-code char_pred s start end)))) (string-every-c-code char_pred s start end))))
;; A variant of string-fill! that we keep for compatability
;;
(define (substring-fill! str start end fill) (define (substring-fill! str start end fill)
"A variant of string-fill! that we keep for compatibility."
(string-fill! str fill start end)) (string-fill! str fill start end))
@ -1705,10 +1695,10 @@ written into the port is returned."
;;; {Loading by paths} ;;; {Loading by paths}
;;; ;;;
;;; Load a Scheme source file named NAME, searching for it in the
;;; directories listed in %load-path, and applying each of the file
;;; name extensions listed in %load-extensions.
(define (load-from-path name) (define (load-from-path name)
"Load a Scheme source file named NAME, searching for it in the
directories listed in %load-path, and applying each of the file
name extensions listed in %load-extensions."
(start-stack 'load-stack (start-stack 'load-stack
(primitive-load-path name))) (primitive-load-path name)))
@ -1997,10 +1987,9 @@ written into the port is returned."
;; make-module &opt size uses binder ;; make-module &opt size uses binder
;; ;;
;; Create a new module, perhaps with a particular size of obarray,
;; initial uses list, or binding procedure.
;;
(define* (make-module #:optional (size 31) (uses '()) (binder #f)) (define* (make-module #:optional (size 31) (uses '()) (binder #f))
"Create a new module, perhaps with a particular size of obarray,
initial uses list, or binding procedure."
(if (not (integer? size)) (if (not (integer? size))
(error "Illegal size to make-module." size)) (error "Illegal size to make-module." size))
(if (not (and (list? uses) (if (not (and (list? uses)
@ -2029,15 +2018,15 @@ written into the port is returned."
(cons module proc)) (cons module proc))
(define* (module-observe-weak module observer-id #:optional (proc observer-id)) (define* (module-observe-weak module observer-id #:optional (proc observer-id))
;; Register PROC as an observer of MODULE under name OBSERVER-ID (which can "Register PROC as an observer of MODULE under name OBSERVER-ID (which can
;; be any Scheme object). PROC is invoked and passed MODULE any time be any Scheme object). PROC is invoked and passed MODULE any time
;; MODULE is modified. PROC gets unregistered when OBSERVER-ID gets GC'd MODULE is modified. PROC gets unregistered when OBSERVER-ID gets GC'd
;; (thus, it is never unregistered if OBSERVER-ID is an immediate value, (thus, it is never unregistered if OBSERVER-ID is an immediate value,
;; for instance). for instance).
;; The two-argument version is kept for backward compatibility: when called The two-argument version is kept for backward compatibility: when called
;; with two arguments, the observer gets unregistered when closure PROC with two arguments, the observer gets unregistered when closure PROC
;; gets GC'd (making it impossible to use an anonymous lambda for PROC). gets GC'd (making it impossible to use an anonymous lambda for PROC)."
(hashq-set! (module-weak-observers module) observer-id proc)) (hashq-set! (module-weak-observers module) observer-id proc))
(define (module-unobserve token) (define (module-unobserve token)
@ -2103,13 +2092,10 @@ written into the port is returned."
;;; of M.'' ;;; of M.''
;;; ;;;
;; module-search fn m
;;
;; return the first non-#f result of FN applied to M and then to
;; the modules in the uses of m, and so on recursively. If all applications
;; return #f, then so does this function.
;;
(define (module-search fn m v) (define (module-search fn m v)
"Return the first non-#f result of FN applied to M and then to
the modules in the uses of M, and so on recursively. If all applications
return #f, then so does this function."
(define (loop pos) (define (loop pos)
(and (pair? pos) (and (pair? pos)
(or (module-search fn (car pos) v) (or (module-search fn (car pos) v)
@ -2124,21 +2110,15 @@ written into the port is returned."
;;; of S in M has been set to some well-defined value. ;;; of S in M has been set to some well-defined value.
;;; ;;;
;; module-locally-bound? module symbol
;;
;; Is a symbol bound (interned and defined) locally in a given module?
;;
(define (module-locally-bound? m v) (define (module-locally-bound? m v)
"Is symbol V bound (interned and defined) locally in module M?"
(let ((var (module-local-variable m v))) (let ((var (module-local-variable m v)))
(and var (and var
(variable-bound? var)))) (variable-bound? var))))
;; module-bound? module symbol
;;
;; Is a symbol bound (interned and defined) anywhere in a given module
;; or its uses?
;;
(define (module-bound? m v) (define (module-bound? m v)
"Is symbol V bound (interned and defined) anywhere in module M or its
uses?"
(let ((var (module-variable m v))) (let ((var (module-variable m v)))
(and var (and var
(variable-bound? var)))) (variable-bound? var))))
@ -2170,22 +2150,16 @@ written into the port is returned."
(define (module-obarray-remove! ob key) (define (module-obarray-remove! ob key)
((if (symbol? key) hashq-remove! hash-remove!) ob key)) ((if (symbol? key) hashq-remove! hash-remove!) ob key))
;; module-symbol-locally-interned? module symbol
;;
;; is a symbol interned (not neccessarily defined) locally in a given module
;; or its uses? Interned symbols shadow inherited bindings even if
;; they are not themselves bound to a defined value.
;;
(define (module-symbol-locally-interned? m v) (define (module-symbol-locally-interned? m v)
"Is symbol V interned (not neccessarily defined) locally in module M
or its uses? Interned symbols shadow inherited bindings even if they
are not themselves bound to a defined value."
(not (not (module-obarray-get-handle (module-obarray m) v)))) (not (not (module-obarray-get-handle (module-obarray m) v))))
;; module-symbol-interned? module symbol
;;
;; is a symbol interned (not neccessarily defined) anywhere in a given module
;; or its uses? Interned symbols shadow inherited bindings even if
;; they are not themselves bound to a defined value.
;;
(define (module-symbol-interned? m v) (define (module-symbol-interned? m v)
"Is symbol V interned (not neccessarily defined) anywhere in module M
or its uses? Interned symbols shadow inherited bindings even if they
are not themselves bound to a defined value."
(module-search module-symbol-locally-interned? m v)) (module-search module-symbol-locally-interned? m v))
@ -2217,14 +2191,10 @@ written into the port is returned."
;;; variable is dereferenced. ;;; variable is dereferenced.
;;; ;;;
;; module-symbol-binding module symbol opt-value
;;
;; return the binding of a variable specified by name within
;; a given module, signalling an error if the variable is unbound.
;; If the OPT-VALUE is passed, then instead of signalling an error,
;; return OPT-VALUE.
;;
(define (module-symbol-local-binding m v . opt-val) (define (module-symbol-local-binding m v . opt-val)
"Return the binding of variable V specified by name within module M,
signalling an error if the variable is unbound. If the OPT-VALUE is
passed, then instead of signalling an error, return OPT-VALUE."
(let ((var (module-local-variable m v))) (let ((var (module-local-variable m v)))
(if (and var (variable-bound? var)) (if (and var (variable-bound? var))
(variable-ref var) (variable-ref var)
@ -2232,14 +2202,10 @@ written into the port is returned."
(car opt-val) (car opt-val)
(error "Locally unbound variable." v))))) (error "Locally unbound variable." v)))))
;; module-symbol-binding module symbol opt-value
;;
;; return the binding of a variable specified by name within
;; a given module, signalling an error if the variable is unbound.
;; If the OPT-VALUE is passed, then instead of signalling an error,
;; return OPT-VALUE.
;;
(define (module-symbol-binding m v . opt-val) (define (module-symbol-binding m v . opt-val)
"Return the binding of variable V specified by name within module M,
signalling an error if the variable is unbound. If the OPT-VALUE is
passed, then instead of signalling an error, return OPT-VALUE."
(let ((var (module-variable m v))) (let ((var (module-variable m v)))
(if (and var (variable-bound? var)) (if (and var (variable-bound? var))
(variable-ref var) (variable-ref var)
@ -2253,15 +2219,12 @@ written into the port is returned."
;;; {Adding Variables to Modules} ;;; {Adding Variables to Modules}
;;; ;;;
;; module-make-local-var! module symbol
;;
;; ensure a variable for V in the local namespace of M.
;; If no variable was already there, then create a new and uninitialzied
;; variable.
;;
;; This function is used in modules.c. ;; This function is used in modules.c.
;; ;;
(define (module-make-local-var! m v) (define (module-make-local-var! m v)
"Ensure a variable for V in the local namespace of M.
If no variable was already there, then create a new and uninitialized
variable."
(or (let ((b (module-obarray-ref (module-obarray m) v))) (or (let ((b (module-obarray-ref (module-obarray m) v)))
(and (variable? b) (and (variable? b)
(begin (begin
@ -2275,13 +2238,10 @@ written into the port is returned."
(module-add! m v local-var) (module-add! m v local-var)
local-var))) local-var)))
;; module-ensure-local-variable! module symbol
;;
;; Ensure that there is a local variable in MODULE for SYMBOL. If
;; there is no binding for SYMBOL, create a new uninitialized
;; variable. Return the local variable.
;;
(define (module-ensure-local-variable! module symbol) (define (module-ensure-local-variable! module symbol)
"Ensure that there is a local variable in MODULE for SYMBOL. If
there is no binding for SYMBOL, create a new uninitialized
variable. Return the local variable."
(or (module-local-variable module symbol) (or (module-local-variable module symbol)
(let ((var (make-undefined-variable))) (let ((var (make-undefined-variable)))
(module-add! module symbol var) (module-add! module symbol var)
@ -2289,9 +2249,8 @@ written into the port is returned."
;; module-add! module symbol var ;; module-add! module symbol var
;; ;;
;; ensure a particular variable for V in the local namespace of M.
;;
(define (module-add! m v var) (define (module-add! m v var)
"Ensure a particular variable for V in the local namespace of M."
(if (not (variable? var)) (if (not (variable? var))
(error "Bad variable to module-add!" var)) (error "Bad variable to module-add!" var))
(if (not (symbol? v)) (if (not (symbol? v))
@ -2299,11 +2258,8 @@ written into the port is returned."
(module-obarray-set! (module-obarray m) v var) (module-obarray-set! (module-obarray m) v var)
(module-modified m)) (module-modified m))
;; module-remove!
;;
;; make sure that a symbol is undefined in the local namespace of M.
;;
(define (module-remove! m v) (define (module-remove! m v)
"Make sure that symbol V is undefined in the local namespace of M."
(module-obarray-remove! (module-obarray m) v) (module-obarray-remove! (module-obarray m) v)
(module-modified m)) (module-modified m))
@ -2313,9 +2269,8 @@ written into the port is returned."
;; MODULE-FOR-EACH -- exported ;; MODULE-FOR-EACH -- exported
;; ;;
;; Call PROC on each symbol in MODULE, with arguments of (SYMBOL VARIABLE).
;;
(define (module-for-each proc module) (define (module-for-each proc module)
"Call PROC on each symbol in MODULE, with arguments of (SYMBOL VARIABLE)."
(hash-for-each proc (module-obarray module))) (hash-for-each proc (module-obarray module)))
(define (module-map proc module) (define (module-map proc module)
@ -2357,12 +2312,10 @@ written into the port is returned."
;;; {MODULE-REF -- exported} ;;; {MODULE-REF -- exported}
;;; ;;;
;; Returns the value of a variable called NAME in MODULE or any of its
;; used modules. If there is no such variable, then if the optional third
;; argument DEFAULT is present, it is returned; otherwise an error is signaled.
;;
(define (module-ref module name . rest) (define (module-ref module name . rest)
"Returns the value of a variable called NAME in MODULE or any of its
used modules. If there is no such variable, then if the optional third
argument DEFAULT is present, it is returned; otherwise an error is signaled."
(let ((variable (module-variable module name))) (let ((variable (module-variable module name)))
(if (and variable (variable-bound? variable)) (if (and variable (variable-bound? variable))
(variable-ref variable) (variable-ref variable)
@ -2373,10 +2326,9 @@ written into the port is returned."
;; MODULE-SET! -- exported ;; MODULE-SET! -- exported
;; ;;
;; Sets the variable called NAME in MODULE (or in a module that MODULE uses)
;; to VALUE; if there is no such variable, an error is signaled.
;;
(define (module-set! module name value) (define (module-set! module name value)
"Sets the variable called NAME in MODULE (or in a module that MODULE uses)
to VALUE; if there is no such variable, an error is signaled."
(let ((variable (module-variable module name))) (let ((variable (module-variable module name)))
(if variable (if variable
(variable-set! variable value) (variable-set! variable value)
@ -2384,10 +2336,9 @@ written into the port is returned."
;; MODULE-DEFINE! -- exported ;; MODULE-DEFINE! -- exported
;; ;;
;; Sets the variable called NAME in MODULE to VALUE; if there is no such
;; variable, it is added first.
;;
(define (module-define! module name value) (define (module-define! module name value)
"Sets the variable called NAME in MODULE to VALUE; if there is no such
variable, it is added first."
(let ((variable (module-local-variable module name))) (let ((variable (module-local-variable module name)))
(if variable (if variable
(begin (begin
@ -2398,18 +2349,14 @@ written into the port is returned."
;; MODULE-DEFINED? -- exported ;; MODULE-DEFINED? -- exported
;; ;;
;; Return #t iff NAME is defined in MODULE (or in a module that MODULE
;; uses)
;;
(define (module-defined? module name) (define (module-defined? module name)
"Return #t iff NAME is defined in MODULE (or in a module that MODULE
uses)."
(let ((variable (module-variable module name))) (let ((variable (module-variable module name)))
(and variable (variable-bound? variable)))) (and variable (variable-bound? variable))))
;; MODULE-USE! module interface
;;
;; Add INTERFACE to the list of interfaces used by MODULE.
;;
(define (module-use! module interface) (define (module-use! module interface)
"Add INTERFACE to the list of interfaces used by MODULE."
(if (not (or (eq? module interface) (if (not (or (eq? module interface)
(memq interface (module-uses module)))) (memq interface (module-uses module))))
(begin (begin
@ -2421,12 +2368,9 @@ written into the port is returned."
(hash-clear! (module-import-obarray module)) (hash-clear! (module-import-obarray module))
(module-modified module)))) (module-modified module))))
;; MODULE-USE-INTERFACES! module interfaces
;;
;; Same as MODULE-USE!, but only notifies module observers after all
;; interfaces are added to the inports list.
;;
(define (module-use-interfaces! module interfaces) (define (module-use-interfaces! module interfaces)
"Same as MODULE-USE!, but only notifies module observers after all
interfaces are added to the inports list."
(let* ((cur (module-uses module)) (let* ((cur (module-uses module))
(new (let lp ((in interfaces) (out '())) (new (let lp ((in interfaces) (out '()))
(if (null? in) (if (null? in)
@ -2764,40 +2708,6 @@ written into the port is returned."
(eq? (car (last-pair use-list)) the-scm-module)) (eq? (car (last-pair use-list)) the-scm-module))
(set-module-uses! module (reverse (cdr (reverse use-list))))))) (set-module-uses! module (reverse (cdr (reverse use-list)))))))
;; Return a module that is an interface to the module designated by
;; NAME.
;;
;; `resolve-interface' takes four keyword arguments:
;;
;; #:select SELECTION
;;
;; SELECTION is a list of binding-specs to be imported; A binding-spec
;; is either a symbol or a pair of symbols (ORIG . SEEN), where ORIG
;; is the name in the used module and SEEN is the name in the using
;; module. Note that SEEN is also passed through RENAMER, below. The
;; default is to select all bindings. If you specify no selection but
;; a renamer, only the bindings that already exist in the used module
;; are made available in the interface. Bindings that are added later
;; are not picked up.
;;
;; #:hide BINDINGS
;;
;; BINDINGS is a list of bindings which should not be imported.
;;
;; #:prefix PREFIX
;;
;; PREFIX is a symbol that will be appended to each exported name.
;; The default is to not perform any renaming.
;;
;; #:renamer RENAMER
;;
;; RENAMER is a procedure that takes a symbol and returns its new
;; name. The default is not perform any renaming.
;;
;; Signal "no code for module" error if module name is not resolvable
;; or its public interface is not available. Signal "no binding"
;; error if selected binding does not exist in the used module.
;;
(define* (resolve-interface name #:key (define* (resolve-interface name #:key
(select #f) (select #f)
(hide '()) (hide '())
@ -2806,6 +2716,39 @@ written into the port is returned."
(symbol-prefix-proc prefix) (symbol-prefix-proc prefix)
identity)) identity))
version) version)
"Return a module that is an interface to the module designated by
NAME.
`resolve-interface' takes four keyword arguments:
#:select SELECTION
SELECTION is a list of binding-specs to be imported; A binding-spec
is either a symbol or a pair of symbols (ORIG . SEEN), where ORIG
is the name in the used module and SEEN is the name in the using
module. Note that SEEN is also passed through RENAMER, below. The
default is to select all bindings. If you specify no selection but
a renamer, only the bindings that already exist in the used module
are made available in the interface. Bindings that are added later
are not picked up.
#:hide BINDINGS
BINDINGS is a list of bindings which should not be imported.
#:prefix PREFIX
PREFIX is a symbol that will be appended to each exported name.
The default is to not perform any renaming.
#:renamer RENAMER
RENAMER is a procedure that takes a symbol and returns its new
name. The default is not perform any renaming.
Signal \"no code for module\" error if module name is not resolvable
or its public interface is not available. Signal \"no binding\"
error if selected binding does not exist in the used module."
(let* ((module (resolve-module name #t version #:ensure #f)) (let* ((module (resolve-module name #t version #:ensure #f))
(public-i (and module (module-public-interface module)))) (public-i (and module (module-public-interface module))))
(unless public-i (unless public-i
@ -3460,12 +3403,11 @@ but it fails to load."
(lambda formals body ...)) (lambda formals body ...))
;; Export a local variable
;; This function is called from "modules.c". If you change it, be ;; This function is called from "modules.c". If you change it, be
;; sure to update "modules.c" as well. ;; sure to update "modules.c" as well.
(define (module-export! m names) (define (module-export! m names)
"Export a local variable."
(let ((public-i (module-public-interface m))) (let ((public-i (module-public-interface m)))
(for-each (lambda (name) (for-each (lambda (name)
(let* ((internal-name (if (pair? name) (car name) name)) (let* ((internal-name (if (pair? name) (car name) name))
@ -3486,9 +3428,8 @@ but it fails to load."
(module-add! public-i external-name var))) (module-add! public-i external-name var)))
names))) names)))
;; Export all local variables from a module
;;
(define (module-export-all! mod) (define (module-export-all! mod)
"Export all local variables from a module."
(define (fresh-interface!) (define (fresh-interface!)
(let ((iface (make-module))) (let ((iface (make-module)))
(set-module-name! iface (module-name mod)) (set-module-name! iface (module-name mod))
@ -3500,9 +3441,8 @@ but it fails to load."
(fresh-interface!)))) (fresh-interface!))))
(set-module-obarray! iface (module-obarray mod)))) (set-module-obarray! iface (module-obarray mod))))
;; Re-export a imported variable
;;
(define (module-re-export! m names) (define (module-re-export! m names)
"Re-export an imported variable."
(let ((public-i (module-public-interface m))) (let ((public-i (module-public-interface m)))
(for-each (lambda (name) (for-each (lambda (name)
(let* ((internal-name (if (pair? name) (car name) name)) (let* ((internal-name (if (pair? name) (car name) name))