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.

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
+  (let ((key (make-symbol "while-key")))
+    `(do ()
+         ((catch ',key
                  (lambda ()
-		  (proc (lambda () (throw key #t))
-			(lambda () (throw key #f))))
-		(lambda (key arg) arg)))))
-  `(,while-helper (,lambda (break continue)
+                   (let ((break (lambda () (throw ',key #t)))
+                         (continue (lambda () (throw ',key #f))))
                      (do ()
-			((,not ,cond))
+                         ((not ,cond))
                        ,@body)
-		    #t)))
+                     #t))
+                 (lambda (key arg)
+                   arg))))))
 
 
 

ice-9/runq.scm

@@ -216,13 +216,14 @@
 ;;;
 ;;; 		Returns a new strip which is the concatenation of the argument strips.
 ;;;
-(define ((strip-sequence . strips))
+(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))))))))
+                 (lambda () (loop (cdr st)))))))))
 
 
 ;;;;

ice-9/session.scm

@@ -22,24 +22,22 @@
   :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))
 
 
 
 ;;; Documentation
 ;;;
-(define help
-  (procedure->syntax
-    (lambda (exp env)
+(define-macro (help . exp)
   "(help [NAME])
 Prints useful information.  Try `(help)'."
-      (cond ((not (= (length exp) 2))
+  (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 (cadr exp))
+         (let ((name (car exp))
                (not-found (lambda (type x)
                             (simple-format #t "No ~A found for ~A\n"
                                            type x))))
@@ -61,7 +59,7 @@ You don't seem to have regular expressions installed.\n"))
                   (= (length name) 2)
                   (eq? (car name) 'unquote))
              (cond ((object-documentation
-                         (local-eval (cadr name) env))
+                     (eval (cadr name) (current-module)))
                     => write-line)
                    (else (not-found 'documentation (cadr name)))))
 
@@ -88,7 +86,7 @@ You don't seem to have regular expressions installed.\n"))
             ;; unrecognized
             (else
              (help-usage)))
-               *unspecified*))))))
+           '(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

ice-9/string-fun.scm

@@ -197,9 +197,10 @@
 ;;; (define-public string-prefix=? (string-prefix-predicate string=?))
 ;;;
 
-(define ((string-prefix-predicate pred?) prefix str)
+(define (string-prefix-predicate pred?)
+  (lambda (prefix str)
     (and (<= (string-length prefix) (string-length str))
-       (pred? prefix (substring str 0 (string-length prefix)))))
+         (pred? prefix (substring str 0 (string-length prefix))))))
 
 (define string-prefix=? (string-prefix-predicate string=?))
 

ice-9/threads.scm

@@ -47,12 +47,13 @@
 
 
 
-(define ((par-mapper mapper)  proc . arglists)
+(define (par-mapper mapper)
+  (lambda (proc . arglists)
     (mapper join-thread
             (apply map
                    (lambda args
                      (begin-thread (apply proc args)))
-		 arglists)))
+                   arglists))))
 
 (define par-map (par-mapper map))
 (define par-for-each (par-mapper for-each))