* strings.h: don't use SCM_P. don't include <string.h>.

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

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index b1b0cd5..0efd8ec 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -43,6 +43,9 @@
 ;;; presumably deprecated.
 (define feature? provided?)
 
+;;; let format alias simple-format until the more complete version is loaded
+(define format simple-format)
+
 \f
 ;;; {R4RS compliance}
 
@@ -301,27 +304,8 @@
 ;;; {Arrays}
 ;;;
 
-(begin
-  (define uniform-vector? array?)
-  (define make-uniform-vector dimensions->uniform-array)
-  ;      (define uniform-vector-ref array-ref)
-  (define (uniform-vector-set! u i o)
-    (uniform-array-set1! u o i))
-  (define uniform-vector-fill! array-fill!)
-  (define uniform-vector-read! uniform-array-read!)
-  (define uniform-vector-write uniform-array-write)
-
-  (define (make-array fill . args)
-    (dimensions->uniform-array args () fill))
-  (define (make-uniform-array prot . args)
-    (dimensions->uniform-array args prot))
-  (define (list->array ndim lst)
-    (list->uniform-array ndim '() lst))
-  (define (list->uniform-vector prot lst)
-    (list->uniform-array 1 prot lst))
-  (define (array-shape a)
-    (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
-        (array-dimensions a))))
+(if (provided? 'array)
+    (primitive-load-path "ice-9/arrays.scm"))
 
 \f
 ;;; {Keywords}
@@ -610,10 +594,10 @@
   (save-stack)
   (if (null? args)
       (scm-error 'misc-error #f "?" #f #f)
-      (let loop ((msg "%s")
+      (let loop ((msg "~A")
                 (rest (cdr args)))
        (if (not (null? rest))
-           (loop (string-append msg " %S")
+           (loop (string-append msg " ~S")
                  (cdr rest))
            (scm-error 'misc-error #f msg args #f)))))
 
@@ -902,48 +886,6 @@
 (read-hash-extend #\. (lambda (c port)
                        (eval (read port))))
 
-(if (provided? 'array)
-    (begin
-      (let ((make-array-proc (lambda (template)
-                              (lambda (c port)
-                                (read:uniform-vector template port)))))
-       (for-each (lambda (char template)
-                   (read-hash-extend char
-                                     (make-array-proc template)))
-                 '(#\b #\a #\u #\e #\s #\i #\c #\y   #\h)
-                 '(#t  #\a 1   -1  1.0 1/3 0+i #\nul s)))
-      (let ((array-proc (lambda (c port)
-                         (read:array c port))))
-       (for-each (lambda (char) (read-hash-extend char array-proc))
-                 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))))
-
-(define (read:array digit port)
-  (define chr0 (char->integer #\0))
-  (let ((rank (let readnum ((val (- (char->integer digit) chr0)))
-               (if (char-numeric? (peek-char port))
-                   (readnum (+ (* 10 val)
-                               (- (char->integer (read-char port)) chr0)))
-                   val)))
-       (prot (if (eq? #\( (peek-char port))
-                 '()
-                 (let ((c (read-char port)))
-                   (case c ((#\b) #t)
-                         ((#\a) #\a)
-                         ((#\u) 1)
-                         ((#\e) -1)
-                         ((#\s) 1.0)
-                         ((#\i) 1/3)
-                         ((#\c) 0+i)
-                         (else (error "read:array unknown option " c)))))))
-    (if (eq? (peek-char port) #\()
-       (list->uniform-array rank prot (read port))
-       (error "read:array list not found"))))
-
-(define (read:uniform-vector proto port)
-  (if (eq? #\( (peek-char port))
-      (list->uniform-array 1 proto (read port))
-      (error "read:uniform-vector list not found")))
-
 \f
 ;;; {Command Line Options}
 ;;;
@@ -2032,14 +1974,14 @@
 
 (define (find-and-link-dynamic-module module-name)
   (define (make-init-name mod-name)
-    (string-append 'scm_init
+    (string-append "scm_init"
                   (list->string (map (lambda (c)
                                        (if (or (char-alphabetic? c)
                                                (char-numeric? c))
                                            c
                                            #\_))
                                      (string->list mod-name)))
-                  '_module))
+                  "_module"))
 
   ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
   ;; and the `libname' (the name of the module prepended by `lib') in the cdr
@@ -2078,17 +2020,7 @@
   (let ((libtool-filename (in-vicinity libdir
                                       (string-append libname ".la"))))
     (and (file-exists? libtool-filename)
-        (with-input-from-file libtool-filename
-          (lambda ()
-            (let loop ((ln (read-line)))
-              (cond ((eof-object? ln) #f)
-                    ((and (> (string-length ln) 9)
-                          (string=? "dlname='" (substring ln 0 8))
-                          (string-index ln #\' 8))
-                     =>
-                     (lambda (end)
-                       (in-vicinity libdir (substring ln 8 end))))
-                    (else (loop (read-line))))))))))
+        libtool-filename)))
                              
 (define (try-using-sharlib-name libdir libname)
   (in-vicinity libdir (string-append libname ".so")))
@@ -2912,7 +2844,7 @@
                  (sigaction (car sig-msg)
                             (car old-handler)
                             (cdr old-handler))))
-                        signals old-handlers)))))
+           signals old-handlers)))))
 
 (defmacro false-if-exception (expr)
   `(catch #t (lambda () ,expr)