-;;; installed-scm-file
-(define-module #/ice-9/slib)
+;;;; slib.scm --- definitions needed to get SLIB to work with Guile
+;;;;
+;;;; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
+;;;;
+;;;; This file is part of GUILE.
+;;;;
+;;;; GUILE is free software; you can redistribute it and/or modify it
+;;;; under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your
+;;;; option) any later version.
+;;;;
+;;;; GUILE is distributed in the hope that it will be useful, but
+;;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with GUILE; see the file COPYING. If not, write to the
+;;;; Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;;; Boston, MA 02111-1307 USA
+;;;;
+;;;; As a special exception, the Free Software Foundation gives permission
+;;;; for additional uses of the text contained in its release of GUILE.
+;;;;
+;;;; The exception is that, if you link the GUILE library with other files
+;;;; to produce an executable, this does not by itself cause the
+;;;; resulting executable to be covered by the GNU General Public License.
+;;;; Your use of that executable is in no way restricted on account of
+;;;; linking the GUILE library code into it.
+;;;;
+;;;; This exception does not however invalidate any other reasons why
+;;;; the executable file might be covered by the GNU General Public License.
+;;;;
+;;;; This exception applies only to the code released by the
+;;;; Free Software Foundation under the name GUILE. If you copy
+;;;; code from other Free Software Foundation releases into a copy of
+;;;; GUILE, as the General Public License permits, the exception does
+;;;; not apply to the code that you add in this way. To avoid misleading
+;;;; anyone as to the status of such modified files, you must delete
+;;;; this exception notice from them.
+;;;;
+;;;; If you write modifications of your own for GUILE, it is your choice
+;;;; whether to permit this exception to apply to your modifications.
+;;;; If you do not wish that, delete this exception notice.
+;;;;
+(define-module (ice-9 slib)
+ :no-backtrace)
\f
(define slib:exit quit)
(define slib:error error)
-(define slib:eval eval)
-(define defmacro:eval eval)
+(define slib:warn warn)
+(define 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)
(define logical:logxor logxor)
'()))))
-(define (slib:load name)
+;;; 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
+;;; bug reports at some point complaining that the wrong file gets
+;;; loaded when something accidentally appears in the path before
+;;; slib, etc. ad nauseum. However, the right fix seems to involve
+;;; changing catalog:get in slib/require.scm, and I don't expect
+;;; Aubrey will integrate such a change. So I'm just going to punt
+;;; for the time being.
+(define-public (slib:load name)
(save-module-excursion
(lambda ()
(set-current-module slib-module)
- (let* ((errinfo (catch 'system-error
- (lambda ()
- (primitive-load-path name)
- #f)
- (lambda args args)))
- (errinfo (and errinfo
- (catch 'system-error
- (lambda ()
- (primitive-load-path
- (string-append name ".scm"))
- #f)
- (lambda args args)))))
- (if errinfo
+ (let ((errinfo (catch 'system-error
+ (lambda ()
+ (load-from-path name)
+ #f)
+ (lambda args args))))
+ (if (and errinfo
+ (catch 'system-error
+ (lambda ()
+ (load-from-path
+ (string-append name ".scm"))
+ #f)
+ (lambda args args)))
(apply throw errinfo))))))
(define slib:load-source slib:load)
(define slib-parent-dir
(let* ((path (%search-load-path "slib/require.scm")))
(if path
- (make-shared-substring path 0 (- (string-length path) 17))
+ (substring path 0 (- (string-length path) 17))
(error "Could not find slib/require.scm in " %load-path))))
(define-public (implementation-vicinity)
(string-append slib-parent-dir "/"))
-(define (library-vicinity)
+(define-public (library-vicinity)
(string-append (implementation-vicinity) "slib/"))
-(define (scheme-implementation-type) 'guile)
-(define (scheme-implementation-version) "")
+(define-public home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+(define-public (scheme-implementation-type) 'guile)
+(define-public (scheme-implementation-version) "")
(define (output-port-width . arg) 80)
(define (output-port-height . arg) 24)
+(define (identity x) x)
+
+;;; {Random numbers}
+;;;
+(define-public (make-random-state . args)
+ (let ((seed (if (null? args) *random-state* (car args))))
+ (cond ((string? seed))
+ ((number? seed) (set! seed (number->string seed)))
+ (else (let ()
+ (require 'object->string)
+ (set! seed (object->limited-string seed 50)))))
+ (seed->random-state seed)))
;;; {Time}
;;;
`(define-public ,@(cdr exp))
`(%system-define ,@(cdr exp))))))
-(define (software-type) 'UNIX)
+;;; Hack to make syncase macros work in the slib module
+(if (nested-ref the-root-module '(app modules ice-9 syncase))
+ (set-object-property! (module-local-variable (current-module) 'define)
+ '*sc-expander*
+ '(define)))
+
+(define (software-type)
+ "Return a symbol describing the current platform's operating system.
+This may be one of AIX, VMS, UNIX, COHERENT, WINDOWS, MS-DOS, OS/2,
+THINKC, AMIGA, ATARIST, MACH, or ACORN.
+
+Note that most varieties of Unix are considered to be simply \"UNIX\".
+That is because when a program depends on features that are not present
+on every operating system, it is usually better to test for the presence
+or absence of that specific feature. The return value of
+@code{software-type} should only be used for this purpose when there is
+no other easy or unambiguous way of detecting such features."
+ 'UNIX)
(slib:load (in-vicinity (library-vicinity) "require.scm"))
(acons name vicinity *vicinity-table*)))))
(define (install-require-module name vicinity-name file-name)
+ (if (not *catalog*) ;Fix which loads catalog in slib
+ (catalog:get 'random)) ;(doesn't load the feature 'random)
(let ((entry (assq name *catalog*))
(vicinity (cdr (assq vicinity-name *vicinity-table*))))
(let ((path-name (in-vicinity vicinity file-name)))
HCoop / bpt / guile.git / blobdiff