Re: slib primes

[Aubrey Jaffer <agj-FrUbXkNCsVf2fBVCVOL8/A@public.gmane.org>]

 | Date: Thu, 16 Apr 2009 18:44:32 -0400
 | From: Dan Gildea <gildea-e+AXbWqSrlAAvxtiuMwx3w@public.gmane.org>
 | 
 | On Thu, April 16, 2009 at 12:07PM, Aubrey Jaffer wrote:
 | >  | Date: Wed, 15 Apr 2009 20:33:53 -0400
 | >  | From: Dan Gildea <gildea-e+AXbWqSrlAAvxtiuMwx3w@public.gmane.org>
 | >  | 
 | >  | bash-3.2$ guile-1.8
 | >  | guile> (version)
 | >  | "1.8.6"
 | >  | guile> (use-modules (ice-9 slib))
 | >  | guile> *slib-version*
 | >  | "3b1"
 | >  | guile> (require 'primes)
 | >  | ERROR: Wrong number of arguments to #<primitive-procedure list->array>

Use-modules doesn't work on my development machine; but that's not
your problem.  The list->array issue was addressed last year, but I
haven't made a release since then.  The following message includes a
patch to fix the problem.

------- Start of forwarded message -------
From: Aubrey Jaffer <agj-FrUbXkNCsVf2fBVCVOL8/A@public.gmane.org>
In-reply-to: <87od8jjeil.fsf-mXXj517/zsQ@public.gmane.org> (ludo-mXXj517/zsQ@public.gmane.org)
Date: Wed,  9 Apr 2008 20:14:05 -0400 (EDT)

 | From: ludo-mXXj517/zsQ@public.gmane.org (Ludovic =?iso-8859-1?Q?Court=E8s?=)
 | Date: Wed, 09 Apr 2008 16:20:50 +0200
 | 
 | SLIB's `array' module (and possibly others) from SLIB 3b1 appears
 | to be partly inaccessible from Guile 1.8 as reported here:
 | 
 |   http://permalink.gmane.org/gmane.lisp.guile.user/6527
 | 
 | Any idea what to look for?

  In /home/ludo/soft/lib/slib/byte.scm:
    61: 6  [list->array 1 #u32(32) (0 0 1 1 0 1 0 1 0 ...)]

  /home/ludo/soft/lib/slib/byte.scm:61:3: In procedure list->array in expression (list->array 1 (A:fixN8b) ...):
  /home/ludo/soft/lib/slib/byte.scm:61:3: Wrong number of arguments to #<primitive-procedure list->array>

Guile-1.8.1's list->array takes two arguments; but it should take
three (see http://srfi.schemers.org/srfi-63/srfi-63.html or
http://swiss.csail.mit.edu/~jaffer/slib_7.html#SEC193 )

  guile> (array->list (list->array 2 '((0 1) (1 4))))
  ((0 1) (1 4))

  guile> (array->list (list->array 2 '#() '((0 1) (1 4))))

  Backtrace:
  In standard input:
     8: 0* [array->list ...
     8: 1*  [list->array 2 #() ((0 1) (1 4))]

  standard input:8:14: In procedure list->array in expression (list->array 2 (begin #) ...):
  standard input:8:14: Wrong number of arguments to #<primitive-procedure list->array>
  ABORT: (wrong-number-of-args)

Appended is a patch which corrects list->array, as well as providing
missing array->vector and vector->array.

Thanks for your bug report.  The development version is updated:
http://groups.csail.mit.edu/mac/ftpdir/users/jaffer/slib.zip

Also, the CVS repository is updated:
https://savannah.gnu.org/cvs/?group=slib

 | Thanks,
 | Ludovic.
 ...
 | _______________________________________________
 | Slib-discuss mailing list
 | Slib-discuss-mXXj517/zsQ@public.gmane.org
 | http://lists.gnu.org/mailman/listinfo/slib-discuss

Index: guile.init
===================================================================
RCS file: /cvsroot/slib/slib/guile.init,v
retrieving revision 1.69
retrieving revision 1.70
diff -c -r1.69 -r1.70
*** guile.init	25 Feb 2008 20:59:56 -0000	1.69
- --- guile.init	9 Apr 2008 23:23:55 -0000	1.70
***************
*** 559,564 ****
- --- 559,620 ----
  (if (string>=? (scheme-implementation-version) "1.8")
      (module-replace! (current-module) '(make-array)))
  
+ (cond
+  ((string<=? (scheme-implementation-version) "1.8.1")
+ (define (list->array rank proto lst)
+   (define dimensions
+     (do ((shp '() (cons (length row) shp))
+ 	 (row lst (car lst))
+ 	 (rnk (+ -1 rank) (+ -1 rnk)))
+ 	((negative? rnk) (reverse shp))))
+   (let ((nra (apply make-array proto dimensions)))
+     (define (l2ra dims idxs row)
+       (cond ((null? dims)
+ 	     (apply array-set! nra row (reverse idxs)))
+ 	    ((if (not (eqv? (car dims) (length row)))
+ 		 (slib:error 'list->array
+ 			     'non-rectangular 'array dims dimensions))
+ 	     (do ((idx 0 (+ 1 idx))
+ 		  (row row (cdr row)))
+ 		 ((>= idx (car dims)))
+ 	       (l2ra (cdr dims) (cons idx idxs) (car row))))))
+     (l2ra dimensions '() lst)
+     nra))
+ ))
+ 
+ (cond
+  ((not (defined? 'vector->array))
+ (define (vector->array vect prototype . dimensions)
+   (define vdx (vector-length vect))
+   (if (not (eqv? vdx (apply * dimensions)))
+       (slib:error 'vector->array vdx '<> (cons '* dimensions)))
+   (let ((ra (apply make-array prototype dimensions)))
+     (define (v2ra dims idxs)
+       (cond ((null? dims)
+ 	     (set! vdx (+ -1 vdx))
+ 	     (apply array-set! ra (vector-ref vect vdx) (reverse idxs)))
+ 	    (else
+ 	     (do ((idx (+ -1 (car dims)) (+ -1 idx)))
+ 		 ((negative? idx) vect)
+ 	       (v2ra (cdr dims) (cons idx idxs))))))
+     (v2ra dimensions '())
+     ra))
+ (define (array->vector ra)
+   (define dims (array-dimensions ra))
+   (let* ((vdx (apply * dims))
+ 	 (vect (make-vector vdx)))
+     (define (ra2v dims idxs)
+       (if (null? dims)
+ 	  (let ((val (apply array-ref ra (reverse idxs))))
+ 	    (set! vdx (+ -1 vdx))
+ 	    (vector-set! vect vdx val))
+ 	  (do ((idx (+ -1 (car dims)) (+ -1 idx)))
+ 	      ((negative? idx) vect)
+ 	    (ra2v (cdr dims) (cons idx idxs)))))
+     (ra2v dims '())
+     vect))
+ ))
+ 
  (define create-array make-array)
  (define (make-uniform-wrapper prot)
    (if (string? prot) (set! prot (string->number prot)))


_______________________________________________
Slib-discuss mailing list
Slib-discuss-mXXj517/zsQ@public.gmane.org
http://lists.gnu.org/mailman/listinfo/slib-discuss
------- End of forwarded message -------