further compilation fixes -- all files compile fine now

* ice-9/runq.scm (strip-sequence): Remove use of obtuse guile `define'
  extension.

* ice-9/boot-9.scm (while): Redefine so as not to unquote in a procedure.
  Less hygienic. Perhaps we should switch to syncase at some point.

* ice-9/session.scm (help): Redefine as a normal macro, so that it can be
  compiled. Not very useful though -- further effort should go into
  (system repl ...).
  (system-module): Removed, it didn't work, and is not useful as far as I
  can tell.

* ice-9/string-fun.scm (string-prefix-predicate): Remove guile define
  extension usage. Compilation also fixed by `while' compilation fix.

* ice-9/threads.scm (par-mapper): Remove guile define extension usage.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index bdf7d40..daf8e49 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -2730,18 +2730,18 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; This is probably a bug in syncase.
 ;;
 (define-macro (while cond . body)
-  (define (while-helper proc)
-    (do ((key (make-symbol "while-key")))
-       ((catch key
-               (lambda ()
-                 (proc (lambda () (throw key #t))
-                       (lambda () (throw key #f))))
-               (lambda (key arg) arg)))))
-  `(,while-helper (,lambda (break continue)
-                   (do ()
-                       ((,not ,cond))
-                     ,@body)
-                   #t)))
+  (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))))))
 
 
 \f

diff --git a/ice-9/runq.scm b/ice-9/runq.scm
index 6ac4e57..eb1e220 100644 (file)
--- a/ice-9/runq.scm
+++ b/ice-9/runq.scm
@@ -216,13 +216,14 @@
 ;;;
 ;;;            Returns a new strip which is the concatenation of the argument strips.
 ;;;
-(define ((strip-sequence . strips))
-  (let loop ((st (let ((a strips)) (set! strips #f) a)))
-    (and (not (null? st))
-        (let ((then ((car st))))
-          (if then
-              (lambda () (loop (cons then (cdr st))))
-              (lambda () (loop (cdr st))))))))
+(define (strip-sequence . strips)
+  (lambda ()
+    (let loop ((st (let ((a strips)) (set! strips #f) a)))
+      (and (not (null? st))
+           (let ((then ((car st))))
+             (if then
+                 (lambda () (loop (cons then (cdr st))))
+                 (lambda () (loop (cdr st)))))))))
 
 
 ;;;;

diff --git a/ice-9/session.scm b/ice-9/session.scm
index 1c9f480..25cd6e8 100644 (file)
--- a/ice-9/session.scm
+++ b/ice-9/session.scm
@@ -22,73 +22,71 @@
   :use-module (ice-9 rdelim)
   :export (help apropos apropos-internal apropos-fold
           apropos-fold-accessible apropos-fold-exported apropos-fold-all
-          source arity system-module))
+          source arity))
 
 \f
 
 ;;; Documentation
 ;;;
-(define help
-  (procedure->syntax
-    (lambda (exp env)
-      "(help [NAME])
+(define-macro (help . exp)
+  "(help [NAME])
 Prints useful information.  Try `(help)'."
-      (cond ((not (= (length exp) 2))
-             (help-usage))
-            ((not (provided? 'regex))
-             (display "`help' depends on the `regex' feature.
+  (cond ((not (= (length exp) 1))
+         (help-usage))
+        ((not (provided? 'regex))
+         (display "`help' depends on the `regex' feature.
 You don't seem to have regular expressions installed.\n"))
+        (else
+         (let ((name (car exp))
+               (not-found (lambda (type x)
+                            (simple-format #t "No ~A found for ~A\n"
+                                           type x))))
+           (cond
+            
+            ;; SYMBOL
+            ((symbol? name)
+             (help-doc name
+                       (simple-format
+                        #f "^~A$"
+                        (regexp-quote (symbol->string name)))))
+            
+            ;; "STRING"
+            ((string? name)
+             (help-doc name name))
+
+            ;; (unquote SYMBOL)
+            ((and (list? name)
+                  (= (length name) 2)
+                  (eq? (car name) 'unquote))
+             (cond ((object-documentation
+                     (eval (cadr name) (current-module)))
+                    => write-line)
+                   (else (not-found 'documentation (cadr name)))))
+
+            ;; (quote SYMBOL)
+            ((and (list? name)
+                  (= (length name) 2)
+                  (eq? (car name) 'quote)
+                  (symbol? (cadr name)))
+             (cond ((search-documentation-files (cadr name))
+                    => write-line)
+                   (else (not-found 'documentation (cadr name)))))
+
+            ;; (SYM1 SYM2 ...)
+            ((and (list? name)
+                  (and-map symbol? name)
+                  (not (null? name))
+                  (not (eq? (car name) 'quote)))
+             (cond ((module-commentary name)
+                    => (lambda (doc)
+                         (display name) (write-line " commentary:")
+                         (write-line doc)))
+                   (else (not-found 'commentary name))))
+
+            ;; unrecognized
             (else
-             (let ((name (cadr exp))
-                   (not-found (lambda (type x)
-                                (simple-format #t "No ~A found for ~A\n"
-                                               type x))))
-               (cond
-
-                ;; SYMBOL
-                ((symbol? name)
-                 (help-doc name
-                           (simple-format
-                            #f "^~A$"
-                            (regexp-quote (symbol->string name)))))
-
-                ;; "STRING"
-                ((string? name)
-                 (help-doc name name))
-
-                ;; (unquote SYMBOL)
-                ((and (list? name)
-                      (= (length name) 2)
-                      (eq? (car name) 'unquote))
-                 (cond ((object-documentation
-                         (local-eval (cadr name) env))
-                        => write-line)
-                       (else (not-found 'documentation (cadr name)))))
-
-                ;; (quote SYMBOL)
-                ((and (list? name)
-                      (= (length name) 2)
-                      (eq? (car name) 'quote)
-                      (symbol? (cadr name)))
-                 (cond ((search-documentation-files (cadr name))
-                        => write-line)
-                       (else (not-found 'documentation (cadr name)))))
-
-                ;; (SYM1 SYM2 ...)
-                ((and (list? name)
-                      (and-map symbol? name)
-                      (not (null? name))
-                      (not (eq? (car name) 'quote)))
-                 (cond ((module-commentary name)
-                        => (lambda (doc)
-                             (display name) (write-line " commentary:")
-                             (write-line doc)))
-                       (else (not-found 'commentary name))))
-
-                ;; unrecognized
-                (else
-                 (help-usage)))
-               *unspecified*))))))
+             (help-usage)))
+           '(begin)))))
 
 (define (module-filename name)          ; fixme: better way? / done elsewhere?
   (let* ((name (map symbol->string name))
@@ -458,17 +456,4 @@ It is an image under the mapping EXTRACT."
              (display #\'))))))))
   (display ".\n"))
 
-(define system-module
-  (procedure->syntax
-   (lambda (exp env)
-     (let* ((m (nested-ref the-root-module
-                          (append '(app modules) (cadr exp)))))
-       (if (not m)
-          (error "Couldn't find any module named" (cadr exp)))
-       (let ((s (not (procedure-property (module-eval-closure m)
-                                        'system-module))))
-        (set-system-module! m s)
-        (string-append "Module " (symbol->string (module-name m))
-                       " is now a " (if s "system" "user") " module."))))))
-
 ;;; session.scm ends here

diff --git a/ice-9/string-fun.scm b/ice-9/string-fun.scm
index 590a7d2..d8ba21f 100644 (file)
--- a/ice-9/string-fun.scm
+++ b/ice-9/string-fun.scm
@@ -197,9 +197,10 @@
 ;;; (define-public string-prefix=? (string-prefix-predicate string=?))
 ;;;
 
-(define ((string-prefix-predicate pred?) prefix str)
-  (and (<= (string-length prefix) (string-length str))
-       (pred? prefix (substring str 0 (string-length prefix)))))
+(define (string-prefix-predicate pred?)
+  (lambda (prefix str)
+    (and (<= (string-length prefix) (string-length str))
+         (pred? prefix (substring str 0 (string-length prefix))))))
 
 (define string-prefix=? (string-prefix-predicate string=?))
 

diff --git a/ice-9/threads.scm b/ice-9/threads.scm
index cdabb24..bd0f7b7 100644 (file)
--- a/ice-9/threads.scm
+++ b/ice-9/threads.scm
@@ -47,12 +47,13 @@
 
 \f
 
-(define ((par-mapper mapper)  proc . arglists)
-  (mapper join-thread
-         (apply map
-                (lambda args
-                  (begin-thread (apply proc args)))
-                arglists)))
+(define (par-mapper mapper)
+  (lambda (proc . arglists)
+    (mapper join-thread
+            (apply map
+                   (lambda args
+                     (begin-thread (apply proc args)))
+                   arglists))))
 
 (define par-map (par-mapper map))
 (define par-for-each (par-mapper for-each))