summaryrefslogtreecommitdiffstats
path: root/guile.init
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:34 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:34 -0800
commit237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (patch)
tree9832fbdd6fbeedf3fc7f0e7923fe20b7d35b1499 /guile.init
parent5145dd3aa0c02c9fc496d1432fc4410674206e1d (diff)
downloadslib-237c6e380aebdcbc70bd1c9ecf7d3f6effca2752.tar.gz
slib-237c6e380aebdcbc70bd1c9ecf7d3f6effca2752.zip
Import Upstream version 3a3upstream/3a3
Diffstat (limited to 'guile.init')
-rw-r--r--guile.init110
1 files changed, 59 insertions, 51 deletions
diff --git a/guile.init b/guile.init
index a488998..76f1f0e 100644
--- a/guile.init
+++ b/guile.init
@@ -45,9 +45,9 @@
;;; the directory where any auxillary files to your Scheme
;;; implementation reside.
(define implementation-vicinity
- (let* ((path (or (%search-load-path "slib/require.scm")
- (error "Could not find slib/require.scm in " %load-path)))
- (vic (substring path 0 (- (string-length path) 16))))
+ (let* ((path (or (%search-load-path "ice-9/q.scm")
+ (error "Could not find ice-9/q.scm in " %load-path)))
+ (vic (substring path 0 (- (string-length path) 11))))
(lambda () vic)))
;;; (library-vicinity) should be defined to be the pathname of the
@@ -66,7 +66,7 @@
;;; directory, the directory which typically contains files which
;;; customize a computer environment for a user.
(define (home-vicinity)
- (let ((home (getenv "HOME")))
+ (let ((home (and (defined? 'getenv) (getenv "HOME"))))
(and home
(case (software-type)
((unix coherent ms-dos) ;V7 unix has a / on HOME
@@ -79,7 +79,7 @@
;@
(define (user-vicinity)
(case (software-type)
- ((VMS) "[.]")
+ ((vms) "[.]")
(else "")))
;@
(define vicinity:suffix?
@@ -111,7 +111,7 @@
;@
(define sub-vicinity
(case (software-type)
- ((VMS) (lambda
+ ((vms) (lambda
(vic name)
(let ((l (string-length vic)))
(if (or (zero? (string-length vic))
@@ -121,10 +121,10 @@
"." name "]")))))
(else (let ((*vicinity-suffix*
(case (software-type)
- ((NOSVE) ".")
- ((MACOS THINKC) ":")
- ((MS-DOS WINDOWS ATARIST OS/2) "\\")
- ((UNIX COHERENT PLAN9 AMIGA) "/"))))
+ ((nosve) ".")
+ ((macos thinkc) ":")
+ ((ms-dos windows atarist os/2) "\\")
+ ((unix coherent plan9 amiga) "/"))))
(lambda (vic name)
(string-append vic name *vicinity-suffix*))))))
;@
@@ -190,6 +190,7 @@
;STRING-NULL?, APPEND!, 1+,
;-1+, <?, <=?, =?, >?, >=?
;;; object-hash ;has OBJECT-HASH
+ hash ;HASH, HASHV, HASHQ
full-continuation ;can return multiple times
;;; ieee-floating-point ;conforms to IEEE Standard 754-1985
@@ -206,6 +207,7 @@
;;; record ;has user defined data structures
string-port ;has CALL-WITH-INPUT-STRING and
;CALL-WITH-OUTPUT-STRING
+ line-i/o
;;; sort
;;; pretty-print
;;; object->string
@@ -213,7 +215,7 @@
;;; trace ;has macros: TRACE and UNTRACE
;;; compiler ;has (COMPILER)
;;; ed ;(ED) is editor
-;;; system ;posix (system <string>)
+ system ;posix (system <string>)
;;; getenv ;posix (getenv <string>)
;;; program-arguments ;returns list of strings (argv)
;;; current-time ;returns time in seconds since 1/1/1970
@@ -223,6 +225,8 @@
logical
random ;Random numbers
+ array
+ array-for-each
)
(if (defined? 'getenv)
@@ -233,22 +237,10 @@
'(current-time)
'())
- (if (defined? 'system)
- '(system)
- '())
-
- (if (defined? 'array?)
- '(array)
- '())
-
(if (defined? 'char-ready?)
'(char-ready?)
'())
- (if (defined? 'array-for-each)
- '(array-for-each)
- '())
-
*features*))
;;; (OUTPUT-PORT-WIDTH <port>)
@@ -277,16 +269,17 @@
(+ 128 (or (status:term-sig st)
(status:stop-sig st)))))))
-;;; (TMPNAM) makes a temporary file name.
-;;(define tmpnam (let ((cntr 100))
-;; (lambda () (set! cntr (+ 1 cntr))
-;; (string-append "slib_" (number->string cntr)))))
-
-;;; (FILE-EXISTS? <string>)
-;;(define (file-exists? f) #f)
+;;; for line-i/o
+(use-modules (ice-9 popen))
+(define (system->line command . tmp)
+ (let ((ipip (open-input-pipe command)))
+ (define line (read-line ipip))
+ (let ((status (close-pipe ipip)))
+ (and (or (eqv? 0 (status:exit-val status))
+ (status:term-sig status)
+ (status:stop-sig status))
+ (if (eof-object? line) "" line)))))
-;;; (DELETE-FILE <string>)
-;;(define (delete-file f) #f)
(define delete-file
(let ((guile-core-delete-file delete-file))
(lambda (filename)
@@ -354,29 +347,44 @@
;;; Here for backward compatability
;;(define scheme-file-suffix
;; (let ((suffix (case (software-type)
-;; ((NOSVE) "_scm")
+;; ((nosve) "_scm")
;; (else ".scm"))))
;; (lambda () suffix)))
-(define (guile:wrap-case-insensitive proc)
- (lambda args
- (save-module-excursion
- (lambda ()
- (set-current-module slib-module)
- (let ((old (read-options)))
- (dynamic-wind
- (lambda () (read-enable 'case-insensitive))
- (lambda () (apply proc args))
- (lambda () (read-options old))))))))
+;;; (define (guile:wrap-case-insensitive proc)
+;;; (lambda args
+;;; (save-module-excursion
+;;; (lambda ()
+;;; (set-current-module slib-module)
+;;; (let ((old (read-options)))
+;;; (dynamic-wind
+;;; (lambda () (read-enable 'case-insensitive))
+;;; (lambda () (apply proc args))
+;;; (lambda () (read-options old))))))))
-(define read (guile:wrap-case-insensitive read))
+;;; (define read (guile:wrap-case-insensitive read))
;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
;;; suffix all the module files in SLIB have. See feature 'SOURCE.
-(define slib:load
- (let ((load-file (guile:wrap-case-insensitive load)))
- (lambda (<pathname>)
- (load-file (string-append <pathname> (scheme-file-suffix))))))
+;;; (define slib:load
+;;; (let ((load-file (guile:wrap-case-insensitive load)))
+;;; (lambda (<pathname>)
+;;; (load-file (string-append <pathname> (scheme-file-suffix))))))
+(define (slib:load-helper loader)
+ (lambda (name)
+ (save-module-excursion
+ (lambda ()
+ (set-current-module slib-module)
+ (let ((errinfo (catch 'system-error
+ (lambda () (loader name) #f)
+ (lambda args args))))
+ (if (and errinfo
+ (catch 'system-error
+ (lambda () (loader (string-append name ".scm")) #f)
+ (lambda args args)))
+ (apply throw errinfo)))))))
+(define slib:load (slib:load-helper load))
+(define slib:load-from-path (slib:load-helper load-from-path))
(define slib:load-source slib:load)
@@ -524,9 +532,9 @@
(define A:floR32b ar32)
(define A:floR16b ar32)
;; decimal flonums
-(define A:flor128d ar64)
-(define A:flor64d ar64)
-(define A:flor32d ar32)
+(define A:floR128d ar64)
+(define A:floR64d ar64)
+(define A:floR32d ar32)
;; fixnums
(define A:fixZ64b as64)
(define A:fixZ32b as32)