compile occam-channel

[bpt/guile.git] / ice-9 / boot-9.scm

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index d3da2c6..be67560 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -1801,16 +1801,18 @@
 (define (make-modules-in module name)
   (if (null? name)
       module
-      (cond
-       ((module-ref module (car name) #f)
-       => (lambda (m) (make-modules-in m (cdr name))))
-       (else   (let ((m (make-module 31)))
-                 (set-module-kind! m 'directory)
-                 (set-module-name! m (append (or (module-name module)
-                                                 '())
-                                             (list (car name))))
-                 (module-define! module (car name) m)
-                 (make-modules-in m (cdr name)))))))
+      (make-modules-in
+       (let* ((var (module-local-variable module (car name)))
+              (val (and var (variable-bound? var) (variable-ref var))))
+         (if (module? val)
+             val
+             (let ((m (make-module 31)))
+               (set-module-kind! m 'directory)
+               (set-module-name! m (append (or (module-name module) '())
+                                           (list (car name))))
+               (module-define! module (car name) m)
+               m)))
+       (cdr name))))
 
 (define (beautify-user-module! module)
   (let ((interface (module-public-interface module)))
@@ -1833,23 +1835,22 @@
       (if (equal? name '(guile))
           the-root-module
           (let ((full-name (append '(%app modules) name)))
-            (let ((already (nested-ref the-root-module full-name)))
-              (if already
-                  ;; The module already exists...
-                  (if (and (or (null? maybe-autoload) (car maybe-autoload))
-                           (not (module-public-interface already)))
-                      ;; ...but we are told to load and it doesn't contain source, so
-                      (begin
-                        (try-load-module name)
-                        already)
-                      ;; simply return it.
-                      already)
-                  (begin
-                    ;; Try to autoload it if we are told so
-                    (if (or (null? maybe-autoload) (car maybe-autoload))
-                        (try-load-module name))
-                    ;; Get/create it.
-                    (make-modules-in (current-module) full-name)))))))))
+            (let ((already (nested-ref the-root-module full-name))
+                  (autoload (or (null? maybe-autoload) (car maybe-autoload))))
+              (cond
+               ((and already (module? already)
+                     (or (not autoload) (module-public-interface already)))
+                ;; A hit, a palpable hit.
+                already)
+               (autoload
+                ;; Try to autoload the module, and recurse.
+                (try-load-module name)
+                (resolve-module name #f))
+               (else
+                ;; A module is not bound (but maybe something else is),
+                ;; we're not autoloading -- here's the weird semantics,
+                ;; we create an empty module.
+                (make-modules-in the-root-module full-name)))))))))
 
 ;; Cheat.  These bindings are needed by modules.c, but we don't want
 ;; to move their real definition here because that would be unnatural.
@@ -2723,32 +2724,25 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; The inner `do' loop avoids re-establishing a catch every iteration,
 ;; that's only necessary if continue is actually used.  A new key is
 ;; generated every time, so break and continue apply to their originating
-;; `while' even when recursing.  `while-helper' is an easy way to keep the
-;; `key' binding away from the cond and body code.
-;;
-;; FIXME: This is supposed to have an `unquote' on the `do' the same used
-;; for lambda and not, so as to protect against any user rebinding of that
-;; symbol, but unfortunately an unquote breaks with ice-9 syncase, eg.
-;;
-;;     (use-modules (ice-9 syncase))
-;;     (while #f)
-;;     => ERROR: invalid syntax ()
+;; `while' even when recursing.
 ;;
-;; This is probably a bug in syncase.
+;; FIXME: This macro is unintentionally unhygienic with respect to let,
+;; make-symbol, do, throw, catch, lambda, and not.
 ;;
 (define-macro (while cond . body)
-  (let ((key (make-symbol "while-key")))
-    `(do ()
-         ((catch ',key
-                 (lambda ()
-                   (let ((break (lambda () (throw ',key #t)))
-                         (continue (lambda () (throw ',key #f))))
-                     (do ()
-                         ((not ,cond))
-                       ,@body)
-                     #t))
-                 (lambda (key arg)
-                   arg))))))
+  (let ((keyvar (make-symbol "while-keyvar")))
+    `(let ((,keyvar (make-symbol "while-key")))
+       (do ()
+           ((catch ,keyvar
+                   (lambda ()
+                     (let ((break (lambda () (throw ,keyvar #t)))
+                           (continue (lambda () (throw ,keyvar #f))))
+                       (do ()
+                           ((not ,cond))
+                         ,@body)
+                       #t))
+                   (lambda (key arg)
+                     arg)))))))
 
 
 \f
@@ -2982,7 +2976,6 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; Indeed, all references to global variables are memoized into such
 ;; variable objects.
 
-;; FIXME: these don't work with the compiler
 (define-macro (@ mod-name var-name)
   (let ((var (module-variable (resolve-interface mod-name) var-name)))
     (if (not var)
@@ -3000,6 +2993,19 @@ module '(ice-9 q) '(make-q q-length))}."
 
 \f
 
+;;; {Compiler interface}
+;;;
+;;; The full compiler interface can be found in (system). Here we put a
+;;; few useful procedures into the global namespace.
+
+(module-autoload! the-scm-module
+                  '(system base compile)
+                  '(compile
+                    compile-time-environment))
+
+
+\f
+
 ;;; {Parameters}
 ;;;