* boot-9.scm: Doc fixes.
authorJim Blandy <jimb@red-bean.com>
Wed, 16 Oct 1996 02:18:33 +0000 (02:18 +0000)
committerJim Blandy <jimb@red-bean.com>
Wed, 16 Oct 1996 02:18:33 +0000 (02:18 +0000)
(make-module): Rework for readability.
(make-root-module, make-scm-module): USES argument to make-module
should be '(), not #f.

ice-9/boot-9.scm

index 31318a1..bc447e6 100644 (file)
 ;; bindings that would otherwise not be found locally in the module.
 ;;
 (define module-type
-  (make-record-type 'module '(obarray uses binder eval-thunk name kind) %print-module))
+  (make-record-type 'module '(obarray uses binder eval-thunk name kind)
+                   %print-module))
 
-;; make-module &opt size uses
+;; make-module &opt size uses binder
 ;;
-;; Create a new module, perhaps with a particular size of obarray
-;; or initial uses list.
+;; Create a new module, perhaps with a particular size of obarray,
+;; initial uses list, or binding procedure.
 ;;
-(define module-constructor (record-constructor module-type))
-
 (define make-module
     (lambda args
-      (let* ((size 1021)
-            (uses '())
-            (binder #f)
-            (answer #f)
-            (eval-thunk
-             (lambda (symbol define?)
-               (if define?
-                   (module-make-local-var! answer symbol)
-                   (module-variable answer symbol)))))
-
-       (if (> (length args) 0)
-           (begin
-             (set! size (or (car args) size))
-             (set! args (cdr args))))
-
-       (if (> (length args) 0)
-           (begin
-             (set! uses (or (car args) uses))
-             (set! args (cdr args))))
-
-       (if (> (length args) 0)
-           (begin
-             (set! binder (or (car args) binder))
-             (set! args (cdr args))))
-
-       (if (not (null? args))
-           (error "Too many args to make-module." args))
 
-       (if (not (integer? size))
-           (error "Illegal size to make-module." size))
+      (define (parse-arg index default)
+       (if (> (length args) index)
+           (list-ref args index)
+           default))
+
+      (if (> (length args) 3)
+         (error "Too many args to make-module." args))
 
-       (and (list? uses)
-            (or (and-map module? uses)
-                (error "Incorrect use list." uses)))
+      (let ((size (parse-arg 0 1021))
+           (uses (parse-arg 1 '()))
+           (binder (parse-arg 2 #f)))
 
+       (if (not (integer? size))
+           (error "Illegal size to make-module." size))
+       (if (not (and (list? uses)
+                     (and-map module? uses)))
+           (error "Incorrect use list." uses))
        (if (and binder (not (procedure? binder)))
            (error
             "Lazy-binder expected to be a procedure or #f." binder))
 
-       (set! answer
-             (module-constructor (make-vector size '())
-                                 uses
-                                 binder
-                                 eval-thunk
-                                 #f
-                                 #f))
-       answer)))
+       (let ((module (module-constructor (make-vector size '())
+                                         uses binder #f #f #f)))
+
+         ;; We can't pass this as an argument to module-constructor,
+         ;; because we need it to close over a pointer to the module
+         ;; itself.
+         (set-module-eval-thunk! module
+                                 (lambda (symbol define?)
+                                   (if define?
+                                       (module-make-local-var! module symbol)
+                                       (module-variable module symbol))))
+
+         module))))
 
+(define module-constructor (record-constructor module-type))
 (define module-obarray  (record-accessor module-type 'obarray))
 (define set-module-obarray! (record-modifier module-type 'obarray))
 (define module-uses  (record-accessor module-type 'uses))
 (define set-module-kind! (record-modifier module-type 'kind))
 (define module? (record-predicate module-type))
 
+
 (define (eval-in-module exp module)
   (eval2 exp (module-eval-thunk module)))
 
           bi))))
 
 (define (make-root-module)
-  (make-module 1019 #f root-module-thunk))
+  (make-module 1019 '() root-module-thunk))
 
 
 ;; make-scm-module 
 ;;
 
 (define (make-scm-module)
-  (make-module 1019 #f
+  (make-module 1019 '()
               (lambda (m s define?)
                 (let ((bi (and (symbol-interned? #f s)
                                (builtin-variable s))))
 
 ;;;;
 ;;;    local-definitions-in root name
-;;;            Returns a list of names defined locally in the named subdirectory of root.
+;;;            Returns a list of names defined locally in the named
+;;;            subdirectory of root.
 ;;;    definitions-in root name
-;;;            Returns a list of all names defined in the named subdirectory of root.
-;;;            The list includes alll locally defined names as well as all names inherited
-;;;            from a member of a use-list.
+;;;            Returns a list of all names defined in the named
+;;;            subdirectory of root.  The list includes alll locally
+;;;            defined names as well as all names inherited from a
+;;;            member of a use-list.
 ;;;
 ;;; A convenient interface for examining the nature of things:
 ;;;
 ;;;    ls . various-names
 ;;;
-;;;            With just one argument, interpret that argument as the name of a subdirectory
-;;;            of the current module and return a list of names defined there.
+;;;            With just one argument, interpret that argument as the
+;;;            name of a subdirectory of the current module and
+;;;            return a list of names defined there.
 ;;;
-;;;            With more than one argument, still compute subdirectory lists, but
-;;;            return a list:
+;;;            With more than one argument, still compute
+;;;            subdirectory lists, but return a list:
 ;;;                    ((<subdir-name> . <names-defined-there>)
 ;;;                     (<subdir-name> . <names-defined-there>)
 ;;;                     ...)
        m
        (reduce union
                (cons (local-definitions-in m  '())
-                     (map (lambda (m2) (definitions-in m2 '())) (module-uses m)))))))
+                     (map (lambda (m2) (definitions-in m2 '()))
+                          (module-uses m)))))))
 
 (define-public (ls . various-refs)
   (and various-refs