From 20edfbbdb5746a57e6d76af2acb3a8192f4751c5 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Sat, 28 Apr 2001 19:07:38 +0000 Subject: [PATCH] Surround commentary w/ standard markers; nfc. --- ice-9/boot-9.scm | 101 +++++++++++++++++++++++++---------------------- 1 file changed, 53 insertions(+), 48 deletions(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index a4af8fe4b..7fa3f86b3 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -1,31 +1,35 @@ ;;; installed-scm-file ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. -;;;; +;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by ;;;; the Free Software Foundation; either version 2, or (at your option) ;;;; any later version. -;;;; +;;;; ;;;; This program is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; GNU General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with this software; see the file COPYING. If not, write to ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; Boston, MA 02111-1307 USA -;;;; +;;;; +;;; Commentary: + ;;; This file is the first thing loaded into Guile. It adds many mundane ;;; definitions and a few that are interesting. ;;; -;;; The module system (hence the hierarchical namespace) are defined in this +;;; The module system (hence the hierarchical namespace) are defined in this ;;; file. ;;; +;;; Code: + ;;; {Features} ;; @@ -98,12 +102,12 @@ ;;; apply-to-args is functionally redunant with apply and, worse, ;;; is less general than apply since it only takes two arguments. ;;; -;;; On the other hand, apply-to-args is a syntacticly convenient way to +;;; On the other hand, apply-to-args is a syntacticly convenient way to ;;; perform binding in many circumstances when the "let" family of ;;; of forms don't cut it. E.g.: ;;; ;;; (apply-to-args (return-3d-mouse-coords) -;;; (lambda (x y z) +;;; (lambda (x y z) ;;; ...)) ;;; @@ -250,7 +254,7 @@ new-port)) ;; 0: type-name, 1: fields -(define record-type-vtable +(define record-type-vtable (make-vtable-vtable "prpr" 0 (lambda (s p) (cond ((eq? s record-type-vtable) @@ -395,7 +399,7 @@ ;; 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) (let loop ((result #t) (l lst)) @@ -534,7 +538,7 @@ (if (pair? maybe-fd) (set-port-revealed! port 1)) port)) - + (define (dup->inport port/fd . maybe-fd) (apply dup->port port/fd "r" maybe-fd)) @@ -834,9 +838,9 @@ (display help) (newline)))) kw-desc)) - - + + (define (transform-usage-lambda cases) (let* ((raw-usage (delq! 'else (map car cases))) (usage-sans-specials (map (lambda (x) @@ -1062,7 +1066,7 @@ ;;; ;; 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. @@ -1101,7 +1105,7 @@ ;;; {Is a symbol interned in a module?} ;;; -;;; Symbol S in Module M is interned if S occurs in +;;; Symbol S in Module M is interned if S occurs in ;;; of S in M has been set to some well-defined value. ;;; ;;; It is possible to intern a symbol in a module without providing @@ -1127,7 +1131,7 @@ ((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. @@ -1136,7 +1140,7 @@ (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. @@ -1174,8 +1178,8 @@ ;)) ;; module-variable module symbol -;; -;; like module-local-variable, except search the uses in the +;; +;; like module-local-variable, except search the uses in the ;; case V is not found in M. ;; ;; NOTE: This function is superseded with C code (see modules.c) @@ -1192,7 +1196,7 @@ ;;; ;; 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, @@ -1207,7 +1211,7 @@ (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, @@ -1229,7 +1233,7 @@ ;; 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. @@ -1249,7 +1253,7 @@ answer)))) ;; module-add! module symbol var -;; +;; ;; ensure a particular variable for V in the local namespace of M. ;; (define (module-add! m v var) @@ -1258,8 +1262,8 @@ (module-obarray-set! (module-obarray m) v var) (module-modified m)) -;; module-remove! -;; +;; module-remove! +;; ;; make sure that a symbol is undefined in the local namespace of M. ;; (define (module-remove! m v) @@ -1271,7 +1275,7 @@ (module-modified m)) ;; MODULE-FOR-EACH -- exported -;; +;; ;; Call PROC on each symbol in MODULE, with arguments of (SYMBOL VARIABLE). ;; (define (module-for-each proc module) @@ -1304,9 +1308,9 @@ ;;; {Low Level Bootstrapping} ;;; -;; make-root-module +;; make-root-module -;; A root module uses the symhash table (the system's privileged +;; A root module uses the symhash table (the system's privileged ;; obarray). Being inside a root module is like using SCM without ;; any module system. ;; @@ -1324,7 +1328,7 @@ (make-module 1019 '() root-module-closure)) -;; make-scm-module +;; make-scm-module ;; An scm module is a module into which the lazy binder copies ;; variable bindings from the system symhash table. The mapping is @@ -1383,7 +1387,7 @@ ;; 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) (let ((variable (module-variable module name))) (if (and variable (variable-bound? variable)) @@ -1397,7 +1401,7 @@ ;; ;; 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) (let ((variable (module-variable module name))) (if variable @@ -1408,7 +1412,7 @@ ;; ;; 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) (let ((variable (module-local-variable module name))) (if variable @@ -1429,7 +1433,7 @@ ;; MODULE-USE! module interface ;; ;; Add INTERFACE to the list of interfaces used by MODULE. -;; +;; (define (module-use! module interface) (set-module-uses! module (cons interface (delq! interface (module-uses module)))) @@ -1447,7 +1451,7 @@ ;;; modules. ;;; ;;; (nested-ref some-root-module '(foo bar baz)) -;;; => ;;; ;;; @@ -1566,7 +1570,7 @@ (try-load-module name)) ;; Get/create it. (make-modules-in (current-module) full-name)))))) - + (define (beautify-user-module! module) (let ((interface (module-public-interface module))) (if (or (not interface) @@ -1675,7 +1679,7 @@ (loop (cddr kws) reversed-interfaces (append (cadr kws) exports))) - (else + (else (error "unrecognized defmodule argument" kws)))))) (set-current-module module) module)) @@ -1758,9 +1762,9 @@ ;; scm_init_ice_9_gtcltk_module ;; ;; This is your `module init' function. It should call -;; +;; ;; scm_register_module_xxx ("ice-9 gtcltk", scm_init_gtcltk); -;; +;; ;; "ice-9 gtcltk" is the C version of the module name. Slashes are ;; replaced by spaces, the rest is untouched. `scm_init_gtcltk' is ;; the real init function that executes the usual initializations @@ -1901,7 +1905,7 @@ (string-append libname ".la")))) (and (file-exists? libtool-filename) libtool-filename))) - + (define (try-using-sharlib-name libdir libname) (in-vicinity libdir (string-append libname ".so"))) @@ -1959,7 +1963,7 @@ ;; in. The only defined situation right now is `load-toplevel' which ;; triggers for code evaluated at the top-level, for example from the ;; REPL or when loading a file. - + (define eval-case (procedure->memoizing-macro (lambda (exp env) @@ -1968,7 +1972,7 @@ (define (syntax) (error "syntax error in eval-case")) (let loop ((clauses (cdr exp))) - (cond + (cond ((null? clauses) #f) ((not (list? (car clauses))) @@ -2207,7 +2211,7 @@ (let ((status #f) (interactive #t)) (define (loop first) - (let ((next + (let ((next (catch #t (lambda () @@ -2219,7 +2223,7 @@ (with-traps (lambda () (first) - + ;; This line is needed because mark ;; doesn't do closures quite right. ;; Unreferenced locals should be @@ -2232,7 +2236,7 @@ (lambda () (mask-signals)))) lazy-handler-dispatch)) - + (lambda (key . args) (case key ((quit) @@ -2279,7 +2283,7 @@ (apply bad-throw key args)))))))))) (if next (loop next) status))) (set! set-batch-mode?! (lambda (arg) - (cond (arg + (cond (arg (set! interactive #f) (restore-signals)) (#t @@ -2458,7 +2462,7 @@ (primitive-eval sourc)))) (run-hook after-eval-hook sourc) val))) - + (-print (let ((maybe-print (lambda (result) (if (or scm-repl-print-unspecified @@ -2496,7 +2500,7 @@ -eval -print))) (-quit status)))) - + ;;; {IOTA functions: generating lists of numbers} @@ -2693,7 +2697,7 @@ (lambda () (fluid-ref using-readline?)) (lambda (v) (fluid-set! using-readline? v))))) -(define (top-repl) +(define (top-repl) ;; Load emacs interface support if emacs option is given. (if (and (module-defined? the-root-module 'use-emacs-interface) @@ -2701,7 +2705,7 @@ (load-emacs-interface)) ;; Place the user in the guile-user module. - (process-define-module + (process-define-module '((guile-user) :use-module (guile) ;so that bindings will be checked here first :use-module (ice-9 session) @@ -2773,3 +2777,4 @@ (append! %load-path (cons "." '())) +;;; boot-9.scm ends here