diff options
Diffstat (limited to 'guile.init')
| -rw-r--r-- | guile.init | 110 |
1 files changed, 59 insertions, 51 deletions
@@ -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) |