"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "guile-2.init" between
slib-3b5.tar.gz and slib-3b6.tar.gz

About: SLIB is a portable "scheme" (algorithmic language) library meant to provide compatibiliy and utility functions for all standard "scheme" implementations.

guile-2.init  (slib-3b5):guile-2.init  (slib-3b6)
skipping to change at line 174 skipping to change at line 174
open-file open-file
delete-file delete-file
char-code-limit char-code-limit
scheme-file-suffix scheme-file-suffix
gentemp gentemp
make-array make-array
list->array list->array
provide provide
provided?)) provided?))
(define slib-module (current-module))
(module-export-all! (current-module)) (module-export-all! (current-module))
;;; (software-type) should be set to the generic operating system type. ;;; (software-type) should be set to the generic operating system type.
;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
(define (software-type) 'unix) (define (software-type) 'unix)
;;; (scheme-implementation-type) should return the name of the scheme ;;; (scheme-implementation-type) should return the name of the scheme
;;; implementation loading this file. ;;; implementation loading this file.
(define (scheme-implementation-type) 'guile) (define (scheme-implementation-type) 'guile)
skipping to change at line 444 skipping to change at line 442
;;; Define SLIB:EXIT to be the implementation procedure to exit or ;;; Define SLIB:EXIT to be the implementation procedure to exit or
;;; return if exiting not supported. ;;; return if exiting not supported.
(define slib:exit quit) (define slib:exit quit)
;@ ;@
(define scheme-file-suffix (define scheme-file-suffix
(lambda () ".scm")) (lambda () ".scm"))
(define (slib:load <pathname>) (define (slib:load <pathname>)
(save-module-excursion (load (string-append <pathname> (scheme-file-suffix))))
(lambda ()
(set-current-module slib-module)
(load (string-append <pathname> (scheme-file-suffix))))))
;;;(SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever ;;;(SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
;;;suffix all the module files in SLIB have. See feature 'SOURCE. ;;;suffix all the module files in SLIB have. See feature 'SOURCE.
(define slib:load-source slib:load) (define slib:load-source slib:load)
;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
;;; by compiling "foo.scm" if this implementation can compile files. ;;; by compiling "foo.scm" if this implementation can compile files.
;;; See feature 'COMPILED. ;;; See feature 'COMPILED.
(define slib:load-compiled slib:load) (define slib:load-compiled slib:load)
skipping to change at line 562 skipping to change at line 557
(define first-set-bit log2-binary-factors) (define first-set-bit log2-binary-factors)
(define bitwise-merge bitwise-if) (define bitwise-merge bitwise-if)
;;; array-for-each ;;; array-for-each
(define (array-indexes ra) (define (array-indexes ra)
(let ((ra0 (apply make-array '#() (array-shape ra)))) (let ((ra0 (apply make-array '#() (array-shape ra))))
(array-index-map! ra0 list) (array-index-map! ra0 list)
ra0)) ra0))
(define (array:copy! dest source) (define (array:copy! dest source)
(array-map! dest identity source)) (array-map! dest identity source))
;; DIMENSIONS->UNIFORM-ARRAY and list->uniform-array in Guile-1.6.4
;; cannot make empty arrays.
(define make-array (define make-array
(lambda (prot . args) (lambda (prot . args)
(dimensions->uniform-array args (array-prototype prot) (let ((fill (if (memv 0 (array-dimensions prot))
(apply array-ref prot *unspecified*
(map car (array-shape prot)))))) (apply array-ref prot (map car (array-shape prot))))))
(apply make-typed-array
(array-type prot)
fill
args))))
(define (list->array rank proto lst) (define (list->array rank proto lst)
(define dimensions (define dimensions
(do ((shp '() (cons (length row) shp)) (do ((shp '() (cons (length row) shp))
(row lst (car lst)) (row lst (car lst))
(rnk (+ -1 rank) (+ -1 rnk))) (rnk (+ -1 rank) (+ -1 rnk)))
((negative? rnk) (reverse shp)))) ((negative? rnk) (reverse shp))))
(let ((nra (apply make-array proto dimensions))) (let ((nra (apply make-array proto dimensions)))
(define (l2ra dims idxs row) (define (l2ra dims idxs row)
(cond ((null? dims) (cond ((null? dims)
skipping to change at line 621 skipping to change at line 619
(let ((val (apply array-ref ra (reverse idxs)))) (let ((val (apply array-ref ra (reverse idxs))))
(set! vdx (+ -1 vdx)) (set! vdx (+ -1 vdx))
(vector-set! vect vdx val)) (vector-set! vect vdx val))
(do ((idx (+ -1 (car dims)) (+ -1 idx))) (do ((idx (+ -1 (car dims)) (+ -1 idx)))
((negative? idx) vect) ((negative? idx) vect)
(ra2v (cdr dims) (cons idx idxs))))) (ra2v (cdr dims) (cons idx idxs)))))
(ra2v dims '()) (ra2v dims '())
vect)) vect))
(define create-array make-array) (define create-array make-array)
(define (make-uniform-wrapper prot) (define (make-typed-wrapper pair)
(if (string? prot) (set! prot (string->number prot))) (lambda opt
(if prot (if (null? opt)
(lambda opt (list->typed-array (car pair) 1 (list (cdr pair)))
(if (null? opt) (list->typed-array (car pair) 0 (car opt)))))
(list->uniform-array 1 prot (list prot)) (define ac64 (make-typed-wrapper '(c64 . 0.0+0.0i)))
(list->uniform-array 0 prot (car opt)))) (define ac32 (make-typed-wrapper '(c32 . 0.0+0.0i)))
vector)) (define ar64 (make-typed-wrapper '(f64 . 0.0)))
(define ac64 (make-uniform-wrapper "+i")) (define ar32 (make-typed-wrapper '(f32 . 0.0)))
(define ac32 ac64) (define as64 (make-typed-wrapper '(s64 . 0)))
(define ar64 (make-uniform-wrapper "1/3")) (define as32 (make-typed-wrapper '(s32 . 0)))
(define ar32 (make-uniform-wrapper "1.")) (define as16 (make-typed-wrapper '(s16 . 0)))
(define as64 vector) (define as8 (make-typed-wrapper '(s8 . 0)))
(define as32 (make-uniform-wrapper -32)) (define au64 (make-typed-wrapper '(u64 . 0)))
(define as16 as32) (define au32 (make-typed-wrapper '(u32 . 0)))
(define as8 as32) (define au16 (make-typed-wrapper '(u16 . 0)))
(define au64 vector) (define au8 (make-typed-wrapper '(u8 . 0)))
(define au32 (make-uniform-wrapper 32)) (define at1 (make-typed-wrapper '(b . #f)))
(define au16 au32)
(define au8 au32)
(define at1 (make-uniform-wrapper #t))
;;; New SRFI-58 names ;;; New SRFI-58 names
;; flonums ;; flonums
(define A:floC128b ac64) (define A:floC128b ac64)
(define A:floC64b ac64) (define A:floC64b ac64)
(define A:floC32b ac32) (define A:floC32b ac32)
(define A:floC16b ac32) (define A:floC16b ac32)
(define A:floR128b ar64) (define A:floR128b ar64)
(define A:floR64b ar64) (define A:floR64b ar64)
(define A:floR32b ar32) (define A:floR32b ar32)
 End of changes. 5 change blocks. 
32 lines changed or deleted 27 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)