diff --git a/ice-9/slib.scm b/ice-9/slib.scm index bcdf66ae7..1c928d287 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -71,10 +71,10 @@ -(define slib:exit quit) -(define slib:error error) -(define slib:warn warn) -(define slib:eval (lambda (x) (eval x slib-module))) +(define-public slib:exit quit) +(define-public slib:error error) +(define-public slib:warn warn) +(define-public slib:eval (lambda (x) (eval x slib-module))) (define defmacro:eval (lambda (x) (eval x (interaction-environment)))) (define logical:logand logand) (define logical:logior logior) @@ -86,9 +86,9 @@ (define logical:bit-extract bit-extract) (define logical:integer-expt integer-expt) (define logical:ipow-by-squaring ipow-by-squaring) -(define slib:eval-load eval-load) -(define slib:tab #\tab) -(define slib:form-feed #\page) +(define-public slib:eval-load eval-load) +(define-public slib:tab #\tab) +(define-public slib:form-feed #\page) (define slib-module (current-module)) @@ -128,18 +128,10 @@ '(system) '()) - (if (defined? 'array?) - '(array) - '()) - (if (defined? 'char-ready?) '(char-ready?) '()) - (if (defined? 'array-for-each) - '(array-for-each) - '()) - (if (and (string->number "0.0") (inexact? (string->number "0.0"))) '(inexact) '()) @@ -162,6 +154,36 @@ '())))) +;; The array module specified by slib 3a1 is not the same as what guile +;; provides, so we must remove `array' from the features list. +;; +;; The main difference is `create-array' which is similar to +;; `make-uniform-array', but the `Ac64' etc prototype procedures incorporate +;; an initial fill element into the prototype. +;; +;; Believe the array-for-each module will need to be taken from slib when +;; the array module is taken from there, since what the array module creates +;; won't be understood by the guile functions. So remove `array-for-each' +;; from the features list too. +;; +;; Also, slib 3a1 array-for-each specifies an `array-map' which is not in +;; guile (but could be implemented quite easily). +;; +;; ENHANCE-ME: It'd be nice to implement what's necessary, since the guile +;; functions should be more efficient than the implementation in slib. +;; +;; FIXME: Since the *features* variable is shared by slib and the guile +;; core, removing these feature symbols has the unhappy effect of making it +;; look like they aren't in the core either. Let's assume that arrays have +;; been present unconditionally long enough that no guile-specific code will +;; bother to test. An alternative would be to make a new separate +;; *features* variable which the slib stuff operated on, leaving the core +;; mechanism alone. That might be a good thing anyway. +;; +(set! *features* (delq 'array *features*)) +(set! *features* (delq 'array-for-each *features*)) + + ;;; FIXME: Because uers want require to search the path, this uses ;;; load-from-path, which probably isn't a hot idea. slib ;;; doesn't expect this function to search a path, so I expect to get @@ -189,7 +211,7 @@ (lambda args args))) (apply throw errinfo)))))) -(define slib:load-source slib:load) +(define-public slib:load-source slib:load) (define defmacro:load slib:load) (define slib-parent-dir @@ -208,10 +230,58 @@ (define (scheme-implementation-type) 'guile) (define (scheme-implementation-version) "") -(define (output-port-width . arg) 80) -(define (output-port-height . arg) 24) +;; legacy from r3rs, but slib says all implementations provide these +;; ("Legacy" section of the "Miscellany" node in the manual) +(define-public t #t) +(define-public nil #f) + +(define-public (output-port-width . arg) 80) +(define-public (output-port-height . arg) 24) (define (identity x) x) +;; slib 3a1 and up, straight from Template.scm +(define-public (call-with-open-ports . ports) + (define proc (car ports)) + (cond ((procedure? proc) (set! ports (cdr ports))) + (else (set! ports (reverse ports)) + (set! proc (car ports)) + (set! ports (reverse (cdr ports))))) + (let ((ans (apply proc ports))) + (for-each close-port ports) + ans)) + +;; slib (version 3a1) requires open-file accept a symbol r, rb, w or wb for +;; MODES, so extend the guile core open-file accordingly. +;; +;; slib (version 3a1) also calls open-file with strings "rb" or "wb", not +;; sure if that's intentional, but in any case this extension continues to +;; accept strings to make that work. +;; +(define-public open-file + (let ((guile-core-open-file open-file)) + (lambda (filename modes) + (if (symbol? modes) + (set! modes (symbol->string modes))) + (guile-core-open-file filename modes)))) + +;; returning #t/#f instead of throwing an error for failure +(define-public delete-file + (let ((guile-core-delete-file delete-file)) + (lambda (filename) + (catch 'system-error + (lambda () (guile-core-delete-file filename) #t) + (lambda args #f))))) + +;; Nothing special to do for this, so straight from Template.scm. Maybe +;; "sensible-browser" for a debian system would be worth trying too (and +;; would be good on a tty). +(define-public (browse-url url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'"))) + ;;; {Random numbers} ;;; (define (make-random-state . args) @@ -254,8 +324,8 @@ ;;; {Time} ;;; -(define difftime -) -(define offset-time +) +(define-public difftime -) +(define-public offset-time +) (define %system-define define)