* acconfig.h: add HAVE_ARRAYS.

* configure.in: add --disable-arrays option, probably temporary.

	* the following changes allow guile to be built with the array
	"module" omitted.  some of this stuff is just tc7 type support,
	which wouldn't be needed if uniform array types were converted
	to smobs.

	* tag.c (scm_utag_bvect ... scm_utag_cvect): don't define unless
	HAVE_ARRAYS.
	(scm_tag): don't check array types unless HAVE_ARRAYS.

	* sort.c (scm_restricted_vector_sort_x, scm_sorted_p):
	remove the unused array types.
	* (scm_stable_sort, scm_sort): don't support vectors if not
	HAVE_ARRAYS.  a bit excessive.

	* random.c (vector_scale, vector_sum_squares,
	scm_random_solid_sphere_x, scm_random_hollow_sphere_x,
	scm_random_normal_vector_x): don't define unless HAVE_ARRAYS.

	* gh_data.c (makvect, gh_chars2byvect, gh_shorts2svect,
	gh_longs2ivect,	gh_ulongs2uvect, gh_floats2fvect, gh_doubles2dvect,
	gh_uniform_vector_length, gh_uniform_vector_ref):
	don't define unless HAVE_ARRAYS.
	(gh_scm2chars, gh_scm2shorts, gh_scm2longs, gh_scm2floats,
	gh_scm2doubles):
	don't check vector types if not HAVE_ARRAYS.

	* eq.c (scm_equal_p), eval.c (SCM_CEVAL), print.c (scm_iprin1),
	gc.c (scm_gc_mark, scm_gc_sweep), objects.c (scm_class_of):
	don't support the array types unless HAVE_ARRAYS is defined.

	* tags.h: make nine tc7 types conditional on HAVE_ARRAYS.

	* read.c (scm_lreadr): don't check for #* unless HAVE_ARRAYS is
	defined (this should use read-hash-extend).

	* ramap.c, unif.c: don't check whether ARRAYS is defined.

	* vectors.c (scm_vector_set_length_x): moved here from unif.c.  call
	scm_uniform_element_size if HAVE_ARRAYS.
	vectors.h: prototype too.

	* unif.c (scm_uniform_element_size): new procedure.

	* init.c (scm_boot_guile_1): don't call scm_init_ramap or
	scm_init_unif unless HAVE_ARRAYS is defined.

	* __scm.h: don't define ARRAYS.

	* Makefile.am (EXTRA_libguile_la_SOURCES): unif.c and ramap.c
	moved here from	libguile_la_SOURCES.


	* Makefile.am (ice9_sources): add arrays.scm.

	* boot-9.scm: load arrays.scm if 'array is provided.

	* arrays.scm: new file with stuff from boot-9.scm.

ChangeLog

@@ -1,3 +1,9 @@
+1999-11-19  Gary Houston  <ghouston@freewire.co.uk>
+
+	* acconfig.h: add HAVE_ARRAYS.
+
+	* configure.in: add --disable-arrays option, probably temporary.
+
 1999-11-17  Gary Houston  <ghouston@freewire.co.uk>
 
 	* configure.in: check for hstrerror.

NEWS

@@ -34,6 +34,7 @@ appropriately.
 
 ** configure has new options to remove support for certain features:
 
+--disable-arrays   omit array and uniform array support
 --disable-posix    omit posix interfaces
 --disable-net      omit networking interfaces
 --disable-regex    omit regular expression interfaces
@@ -131,8 +132,7 @@ instead of 'system-error, since errno is not relevant.
 ** Certain gethostbyname/gethostbyaddr failures now throw errors with
 specific keys instead of 'system-error.  The latter is inappropriate
 since errno will not have been set.  The keys are:
-'dns-host-not-found, 'dns-try-again, 'dns-no-recovery and
+'host-not-found, 'try-again, 'no-recovery and 'no-data.
-'dns-no-data.
 
 ** sethostent, setnetent, setprotoent, setservent: now take an
 optional argument STAYOPEN, which specifies whether the database

acconfig.h

@@ -116,6 +116,9 @@
 /* Define if the system supports Unix-domain (file-domain) sockets.  */
 #undef HAVE_UNIX_DOMAIN_SOCKETS
 
+/* Define this if you want support for arrays and uniform arrays.  */
+#undef HAVE_ARRAYS
+
 /* This is included as part of a workaround for a autoheader bug. */
 #undef HAVE_REGCOMP
 

configure.in

@@ -56,6 +56,10 @@ AC_ARG_ENABLE(debug-freelist,
     AC_DEFINE(GUILE_DEBUG_FREELIST)
   fi)
 
+AC_ARG_ENABLE(arrays,
+  [  --disable-arrays        omit array and uniform array support],,
+  enable_arrays=yes)
+
 AC_ARG_ENABLE(posix,
   [  --disable-posix         omit posix interfaces],,
   enable_posix=yes)
@@ -75,6 +79,11 @@ AC_DEFINE(READER_EXTENSIONS)
 
 dnl files which are destined for separate modules.
 
+if test "$enable_arrays" = yes; then
+   LIBOBJS="$LIBOBJS ramap.o unif.o"
+   AC_DEFINE(HAVE_ARRAYS)
+fi
+
 if test "$enable_posix" = yes; then
    LIBOBJS="$LIBOBJS filesys.o posix.o"
    AC_DEFINE(HAVE_POSIX)

ice-9/ChangeLog

@@ -1,3 +1,11 @@
+1999-11-19  Gary Houston  <ghouston@freewire.co.uk>
+
+	* Makefile.am (ice9_sources): add arrays.scm.
+
+	* boot-9.scm: load arrays.scm if 'array is provided.
+
+	* arrays.scm: new file with stuff from boot-9.scm.
+
 1999-11-18  Gary Houston  <ghouston@freewire.co.uk>
 
 	* boot-9.scm (read-hash-extend to set up arrays): add 'l' for

ice-9/Makefile.am

@@ -23,7 +23,8 @@ AUTOMAKE_OPTIONS = foreign
 
 # These should be installed and distributed.
 ice9_sources =								\
-	and-let*.scm boot-9.scm calling.scm common-list.scm debug.scm	\
+	and-let*.scm arrays.scm boot-9.scm \
+	calling.scm common-list.scm debug.scm	\
 	debugger.scm emacs.scm expect.scm format.scm			\
 	getopt-gnu-style.scm getopt-long.scm hcons.scm lineio.scm	\
 	ls.scm mapping.scm networking.scm				\

ice-9/boot-9.scm

@@ -301,27 +301,8 @@
 ;;; {Arrays}
 ;;;
 
-(begin
+(if (provided? 'array)
-  (define uniform-vector? array?)
+    (primitive-load-path "ice-9/arrays.scm"))
-  (define make-uniform-vector dimensions->uniform-array)
-  ;      (define uniform-vector-ref array-ref)
-  (define (uniform-vector-set! u i o)
-    (uniform-array-set1! u o i))
-  (define uniform-vector-fill! array-fill!)
-  (define uniform-vector-read! uniform-array-read!)
-  (define uniform-vector-write uniform-array-write)
-
-  (define (make-array fill . args)
-    (dimensions->uniform-array args () fill))
-  (define (make-uniform-array prot . args)
-    (dimensions->uniform-array args prot))
-  (define (list->array ndim lst)
-    (list->uniform-array ndim '() lst))
-  (define (list->uniform-vector prot lst)
-    (list->uniform-array 1 prot lst))
-  (define (array-shape a)
-    (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
-	 (array-dimensions a))))
 
 
 ;;; {Keywords}
@@ -902,48 +883,6 @@
 (read-hash-extend #\. (lambda (c port)
 			(eval (read port))))
 
-(if (provided? 'array)
-    (begin
-      (let ((make-array-proc (lambda (template)
-			       (lambda (c port)
-				 (read:uniform-vector template port)))))
-	(for-each (lambda (char template)
-		    (read-hash-extend char
-				      (make-array-proc template)))
-		  '(#\b #\a #\u #\e #\s #\i #\c #\y   #\h #\l)
-		  '(#t  #\a 1   -1  1.0 1/3 0+i #\nul s   l)))
-      (let ((array-proc (lambda (c port)
-			  (read:array c port))))
-	(for-each (lambda (char) (read-hash-extend char array-proc))
-		  '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))))
-
-(define (read:array digit port)
-  (define chr0 (char->integer #\0))
-  (let ((rank (let readnum ((val (- (char->integer digit) chr0)))
-		(if (char-numeric? (peek-char port))
-		    (readnum (+ (* 10 val)
-				(- (char->integer (read-char port)) chr0)))
-		    val)))
-	(prot (if (eq? #\( (peek-char port))
-		  '()
-		  (let ((c (read-char port)))
-		    (case c ((#\b) #t)
-			  ((#\a) #\a)
-			  ((#\u) 1)
-			  ((#\e) -1)
-			  ((#\s) 1.0)
-			  ((#\i) 1/3)
-			  ((#\c) 0+i)
-			  (else (error "read:array unknown option " c)))))))
-    (if (eq? (peek-char port) #\()
-	(list->uniform-array rank prot (read port))
-	(error "read:array list not found"))))
-
-(define (read:uniform-vector proto port)
-  (if (eq? #\( (peek-char port))
-      (list->uniform-array 1 proto (read port))
-      (error "read:uniform-vector list not found")))
-
 
 ;;; {Command Line Options}
 ;;;

libguile/ChangeLog

@@ -1,3 +1,56 @@
+1999-11-19  Gary Houston  <ghouston@freewire.co.uk>
+
+	* the following changes allow guile to be built with the array
+	"module" omitted.  some of this stuff is just tc7 type support,
+	which wouldn't be needed if uniform array types were converted
+	to smobs.
+	
+	* tag.c (scm_utag_bvect ... scm_utag_cvect): don't define unless
+	HAVE_ARRAYS.
+	(scm_tag): don't check array types unless HAVE_ARRAYS.
+
+	* sort.c (scm_restricted_vector_sort_x, scm_sorted_p):
+	remove the unused array types.
+	* (scm_stable_sort, scm_sort): don't support vectors if not
+	HAVE_ARRAYS.  a bit excessive.
+
+	* random.c (vector_scale, vector_sum_squares, 
+	scm_random_solid_sphere_x, scm_random_hollow_sphere_x,
+	scm_random_normal_vector_x): don't define unless HAVE_ARRAYS.
+
+	* gh_data.c (makvect, gh_chars2byvect, gh_shorts2svect,
+	gh_longs2ivect,	gh_ulongs2uvect, gh_floats2fvect, gh_doubles2dvect,
+	gh_uniform_vector_length, gh_uniform_vector_ref):
+	don't define unless HAVE_ARRAYS.
+	(gh_scm2chars, gh_scm2shorts, gh_scm2longs, gh_scm2floats,
+	gh_scm2doubles):
+	don't check vector types if not HAVE_ARRAYS.
+
+	* eq.c (scm_equal_p), eval.c (SCM_CEVAL), print.c (scm_iprin1),
+	gc.c (scm_gc_mark, scm_gc_sweep), objects.c (scm_class_of):
+	don't support the array types unless HAVE_ARRAYS is defined.
+
+	* tags.h: make nine tc7 types conditional on HAVE_ARRAYS.
+
+	* read.c (scm_lreadr): don't check for #* unless HAVE_ARRAYS is 
+	defined (this should use read-hash-extend).
+
+	* ramap.c, unif.c: don't check whether ARRAYS is defined.
+
+	* vectors.c (scm_vector_set_length_x): moved here from unif.c.  call
+	scm_uniform_element_size if HAVE_ARRAYS.
+	vectors.h: prototype too.
+
+	* unif.c (scm_uniform_element_size): new procedure.
+
+	* init.c (scm_boot_guile_1): don't call scm_init_ramap or 
+	scm_init_unif unless HAVE_ARRAYS is defined.
+
+	* __scm.h: don't define ARRAYS.
+
+	* Makefile.am (EXTRA_libguile_la_SOURCES): unif.c and ramap.c
+	moved here from	libguile_la_SOURCES.
+	
 1999-11-18  Gary Houston  <ghouston@freewire.co.uk>
 
 	* socket.c (scm_htons, scm_ntohs, scm_htonl, scm_ntohl): new

libguile/Makefile.am

@@ -42,10 +42,10 @@ libguile_la_SOURCES = \
     gh_predicates.c gsubr.c guardians.c hash.c hashtab.c init.c		\
     ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c		\
     modules.c numbers.c objects.c objprop.c options.c pairs.c	\
-    ports.c print.c procprop.c procs.c ramap.c random.c read.c	\
+    ports.c print.c procprop.c procs.c random.c read.c	\
     root.c scmsigs.c script.c simpos.c smob.c sort.c		\
     srcprop.c stackchk.c stacks.c stime.c strings.c strop.c strorder.c	\
-    strports.c struct.c symbols.c tag.c throw.c unif.c variable.c	\
+    strports.c struct.c symbols.c tag.c throw.c variable.c	\
     vectors.c version.c vports.c weaks.c
 
 BUILT_SOURCES = \
@@ -65,7 +65,8 @@ BUILT_SOURCES = \
 EXTRA_libguile_la_SOURCES = _scm.h		\
     alloca.c inet_aton.c memmove.c putenv.c strerror.c	\
     threads.c regex-posix.c iselect.c \
-    filesys.c posix.c net_db.c socket.c
+    filesys.c posix.c net_db.c socket.c \
+    ramap.c unif.c
 
 ## This is kind of nasty... there are ".c" files that we don't want to
 ## compile, since they are #included in threads.c.  So instead we list

libguile/__scm.h

@@ -84,13 +84,6 @@
  */
 #undef ENGNOT
 
-/* Include support for uniform arrays?
- *
- * Possibly some of the initialization code depends on this
- * being defined, but that is a bug and should be fixed.
- */
-#define ARRAYS
-
 #undef SCM_CAREFUL_INTS
 
 /* {Unsupported Options}
@@ -111,13 +104,12 @@
 
 #define STACK_CHECKING
 #undef NO_CEVAL_STACK_CHECKING
-#undef LONGLONGS
 
 /* Some auto-generated .h files contain unused prototypes
  * that need these typedefs.
  */
-typedef long long_long;
+typedef long long long_long;
-typedef unsigned long ulong_long;
+typedef unsigned long long ulong_long;
 
 
 

libguile/eq.c

@@ -124,6 +124,7 @@ scm_equal_p (x, y)
 		else
 		  return SCM_BOOL_F;
 	      }
+#ifdef HAVE_ARRAYS
 	case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
 	case scm_tc7_fvect:	case scm_tc7_cvect: case scm_tc7_dvect:
 	case scm_tc7_svect:
@@ -134,6 +135,7 @@ scm_equal_p (x, y)
 	  if (   scm_tc16_array
 	      && scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
 	    return scm_array_equal_p(x, y);
+#endif
 	}
 	return SCM_BOOL_F;
 }

libguile/eval.c

@@ -2531,6 +2531,7 @@ dispatch:
 		      scm_listify (proc, SCM_UNDEFINED));
     case scm_tc7_vector:
     case scm_tc7_wvect:
+#ifdef HAVE_ARRAYS
     case scm_tc7_bvect:
     case scm_tc7_byvect:
     case scm_tc7_svect:
@@ -2541,6 +2542,7 @@ dispatch:
     case scm_tc7_cvect:
 #ifdef HAVE_LONG_LONGS
     case scm_tc7_llvect:
+#endif
 #endif
     case scm_tc7_string:
     case scm_tc7_substring:

libguile/gc.c

@@ -746,6 +746,7 @@ gc_mark_nimp:
 			      sizeof (scm_contregs)) /
 			     sizeof (SCM_STACKITEM)));
       break;
+#ifdef HAVE_ARRAYS
     case scm_tc7_bvect:
     case scm_tc7_byvect:
     case scm_tc7_ivect:
@@ -757,7 +758,7 @@ gc_mark_nimp:
 #ifdef HAVE_LONG_LONGS
     case scm_tc7_llvect:
 #endif
-
+#endif
     case scm_tc7_string:
       SCM_SETGC8MARK (ptr);
       break;
@@ -1168,6 +1169,7 @@ scm_gc_sweep ()
 	      scm_must_free (SCM_CHARS (scmptr));
 	      /*	SCM_SETCHARS(scmptr, 0);*/
 	      break;
+#ifdef HAVE_ARRAYS
 	    case scm_tc7_bvect:
 	      if SCM_GC8MARKP (scmptr)
 		goto c8mrkcontinue;
@@ -1211,6 +1213,7 @@ scm_gc_sweep ()
 		goto c8mrkcontinue;
 	      m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double);
 	      goto freechars;
+#endif
 	    case scm_tc7_substring:
 	      if (SCM_GC8MARKP (scmptr))
 		goto c8mrkcontinue;

libguile/gh.h

@@ -108,18 +108,21 @@ SCM gh_str02scm(char *s);
 void gh_set_substr(char *src, SCM dst, int start, int len);
 SCM gh_symbol2scm(const char *symbol_str);
 SCM gh_ints2scm(int *d, int n);
+
+#ifdef HAVE_ARRAYS
 SCM gh_chars2byvect(char *d, int n);
 SCM gh_shorts2svect(short *d, int n);
 SCM gh_longs2ivect(long *d, int n);
 SCM gh_ulongs2uvect(unsigned long *d, int n);
-SCM gh_doubles2scm(double *d, int n);
 #ifdef SCM_FLOATS
 #ifdef SCM_SINGLES
 SCM gh_floats2fvect(float *d, int n);
 #endif
 SCM gh_doubles2dvect(double *d, int n);
 #endif
+#endif
 
+SCM gh_doubles2scm(double *d, int n);
 
 /* Scheme to C conversion */
 int gh_scm2bool(SCM obj);

libguile/gh_data.c

@@ -152,6 +152,7 @@ gh_doubles2scm (double *d, int n)
   return v;
 }
 
+#ifdef HAVE_ARRAYS
 /* Do not use this function for building normal Scheme vectors, unless
    you arrange for the elements to be protected from GC while you
    initialize the vector.  */
@@ -218,6 +219,7 @@ gh_doubles2dvect (double *d, int n)
   return makvect (m, n, scm_tc7_dvect);
 }
 #endif
+#endif
 
 /* data conversion scheme->C */
 int 
@@ -285,7 +287,9 @@ gh_scm2chars (SCM obj, char *m)
       for (i = 0; i < n; ++i)
 	m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
       break;
+#ifdef HAVE_ARRAYS
     case scm_tc7_byvect:
+#endif
     case scm_tc7_string:
     case scm_tc7_substring:
       n = SCM_LENGTH (obj);
@@ -331,12 +335,14 @@ gh_scm2shorts (SCM obj, short *m)
       for (i = 0; i < n; ++i)
 	m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
       break;
+#ifdef HAVE_ARRAYS
     case scm_tc7_svect:
       n = SCM_LENGTH (obj);
       if (m == 0)
 	m = (short *) malloc (n * sizeof (short));
       memcpy (m, SCM_VELTS (obj), n * sizeof (short));
       break;
+#endif
     default:
       scm_wrong_type_arg (0, 0, obj);
     }
@@ -371,6 +377,7 @@ gh_scm2longs (SCM obj, long *m)
 	  m[i] = SCM_INUMP (val) ? SCM_INUM (val) : scm_num2long (val, 0, 0);
 	}
       break;
+#ifdef HAVE_ARRAYS
     case scm_tc7_ivect:
     case scm_tc7_uvect:
       n = SCM_LENGTH (obj);
@@ -378,6 +385,7 @@ gh_scm2longs (SCM obj, long *m)
 	m = (long *) malloc (n * sizeof (long));
       memcpy (m, SCM_VELTS (obj), n * sizeof (long));
       break;
+#endif
     default:
       scm_wrong_type_arg (0, 0, obj);
     }
@@ -418,6 +426,7 @@ gh_scm2floats (SCM obj, float *m)
 	    m[i] = SCM_REALPART (val);
 	}
       break;
+#ifdef HAVE_ARRAYS
 #ifdef SCM_FLOATS
 #ifdef SCM_SINGLES
     case scm_tc7_fvect:
@@ -434,6 +443,7 @@ gh_scm2floats (SCM obj, float *m)
       for (i = 0; i < n; ++i)
 	m[i] = ((double *) SCM_VELTS (obj))[i];
       break;
+#endif
 #endif
     default:
       scm_wrong_type_arg (0, 0, obj);
@@ -475,6 +485,7 @@ gh_scm2doubles (SCM obj, double *m)
 	    m[i] = SCM_REALPART (val);
 	}
       break;
+#ifdef HAVE_ARRAYS
 #ifdef SCM_FLOATS
 #ifdef SCM_SINGLES
     case scm_tc7_fvect:
@@ -491,6 +502,7 @@ gh_scm2doubles (SCM obj, double *m)
 	m = (double*) malloc (n * sizeof (double));
       memcpy (m, SCM_VELTS (obj), n * sizeof (double));
       break;
+#endif
 #endif
     default:
       scm_wrong_type_arg (0, 0, obj);
@@ -635,7 +647,7 @@ gh_vector_length (SCM v)
   return gh_scm2ulong (scm_vector_length (v));
 }
 
-
+#ifdef HAVE_ARRAYS
 /* uniform vector support */
 
 /* returns the length as a C unsigned long integer */
@@ -657,7 +669,7 @@ gh_uniform_vector_ref (SCM v, SCM ilist)
 /* sets an individual element in a uniform vector */
 /* SCM */
 /* gh_list_to_uniform_array ( */
-
+#endif
 
 /* Data lookups between C and Scheme
 

libguile/init.c

@@ -523,9 +523,11 @@ scm_boot_guile_1 (base, closure)
 #ifdef DEBUG_EXTENSIONS
       scm_init_debug ();	/* Requires macro smobs */
 #endif
-      scm_init_ramap ();
       scm_init_random ();
+#ifdef HAVE_ARRAYS
+      scm_init_ramap ();
       scm_init_unif ();
+#endif
       scm_init_simpos ();
       scm_init_load_path ();
       scm_init_standard_ports ();

libguile/objects.c

@@ -116,6 +116,7 @@ scm_class_of (SCM x)
 	  return scm_class_symbol;
 	case scm_tc7_vector:
 	case scm_tc7_wvect:
+#ifdef HAVE_ARRAYS
 	case scm_tc7_bvect:
 	case scm_tc7_byvect:
 	case scm_tc7_svect:
@@ -124,6 +125,7 @@ scm_class_of (SCM x)
 	case scm_tc7_fvect:
 	case scm_tc7_dvect:
 	case scm_tc7_cvect:
+#endif
 	  return scm_class_vector;
 	case scm_tc7_string:
 	case scm_tc7_substring:

libguile/print.c

@@ -592,6 +592,7 @@ taloop:
 	  }
 	  EXIT_NESTED_DATA (pstate);
 	  break;
+#ifdef HAVE_ARRAYS
 	case scm_tc7_bvect:
 	case scm_tc7_byvect:
 	case scm_tc7_svect:
@@ -605,6 +606,7 @@ taloop:
 #endif
 	  scm_raprin1 (exp, port, pstate);
 	  break;
+#endif
 	case scm_tcs_subrs:
 	  scm_puts (SCM_SUBR_GENERIC (exp) && *SCM_SUBR_GENERIC (exp)
 		    ? "#<primitive-generic "

libguile/ramap.c

@@ -55,8 +55,6 @@
 #include "ramap.h"
 
 
-#ifdef ARRAYS
-
 typedef struct
 {
   char *name;
@@ -2174,5 +2172,3 @@ scm_init_ramap ()
 #include "ramap.x"
   scm_add_feature (s_array_for_each);
 }
-
-#endif /* ARRAYS */

libguile/random.c

@@ -411,6 +411,22 @@ scm_random_uniform (SCM state)
   return scm_makdbl (scm_c_uniform01 (SCM_RSTATE (state)), 0.0);
 }
 
+SCM_PROC (s_random_normal, "random:normal", 0, 1, 0, scm_random_normal);
+
+SCM
+scm_random_normal (SCM state)
+{
+  if (SCM_UNBNDP (state))
+    state = SCM_CDR (scm_var_random_state);
+  SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state),
+	      state,
+	      SCM_ARG1,
+	      s_random_normal);
+  return scm_makdbl (scm_c_normal01 (SCM_RSTATE (state)), 0.0);
+}
+
+#ifdef HAVE_ARRAYS
+
 static void
 vector_scale (SCM v, double c)
 {
@@ -443,13 +459,13 @@ vector_sum_squares (SCM v)
   return sum;
 }
 
-SCM_PROC (s_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, scm_random_solid_sphere_x);
-
 /* For the uniform distribution on the solid sphere, note that in
  * this distribution the length r of the vector has cumulative
  * distribution r^n; i.e., u=r^n is uniform [0,1], so r can be
  * generated as r=u^(1/n).
  */
+SCM_PROC (s_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, scm_random_solid_sphere_x);
+
 SCM
 scm_random_solid_sphere_x (SCM v, SCM state)
 {
@@ -488,21 +504,6 @@ scm_random_hollow_sphere_x (SCM v, SCM state)
   vector_scale (v, 1 / sqrt (vector_sum_squares (v)));
   return SCM_UNSPECIFIED;
 }
-
-SCM_PROC (s_random_normal, "random:normal", 0, 1, 0, scm_random_normal);
-
-SCM
-scm_random_normal (SCM state)
-{
-  if (SCM_UNBNDP (state))
-    state = SCM_CDR (scm_var_random_state);
-  SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state),
-	      state,
-	      SCM_ARG1,
-	      s_random_normal);
-  return scm_makdbl (scm_c_normal01 (SCM_RSTATE (state)), 0.0);
-}
-
 SCM_PROC (s_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, scm_random_normal_vector_x);
 
 SCM
@@ -528,6 +529,8 @@ scm_random_normal_vector_x (SCM v, SCM state)
   return SCM_UNSPECIFIED;
 }
 
+#endif /* HAVE_ARRAYS */
+
 SCM_PROC (s_random_exp, "random:exp", 0, 1, 0, scm_random_exp);
 
 SCM

libguile/read.c

@@ -366,6 +366,7 @@ tryagain_no_flush_ws:
 	  c = scm_flush_ws (port, (char *)NULL);
 	  goto tryagain_no_flush_ws;
 
+#ifdef HAVE_ARRAYS
 	case '*':
 	  j = scm_read_token (c, tok_buf, port, 0);
 	  p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
@@ -373,6 +374,7 @@ tryagain_no_flush_ws:
 	    return p;
 	  else
 	    goto unkshrp;
+#endif
 
 	case '{':
 	  j = scm_read_token (c, tok_buf, port, 1);

libguile/sort.c

@@ -422,10 +422,12 @@ scm_restricted_vector_sort_x (SCM vec, SCM less, SCM startpos, SCM endpos)
     {
     case scm_tc7_vector:	/* the only type we manage is vector */
       break;
+#if 0 /* HAVE_ARRAYS */
     case scm_tc7_ivect:	/* long */
     case scm_tc7_uvect:	/* unsigned */
     case scm_tc7_fvect:	/* float */
     case scm_tc7_dvect:	/* double */
+#endif
     default:
       scm_wta (vec, (char *) SCM_ARG1, s_restricted_vector_sort_x);
     }
@@ -510,10 +512,12 @@ scm_sorted_p (SCM items, SCM less)
 	    return SCM_BOOL_T;
 	  }
 	  break;
+#if 0 /* HAVE_ARRAYS */
 	case scm_tc7_ivect:	/* long */
 	case scm_tc7_uvect:	/* unsigned */
 	case scm_tc7_fvect:	/* float */
 	case scm_tc7_dvect:	/* double */
+#endif
 	default:
 	  scm_wta (items, (char *) SCM_ARG1, s_sorted_p);
 	}
@@ -755,6 +759,8 @@ scm_sort (SCM items, SCM less)
       items = scm_list_copy (items);
       return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
     }
+#ifdef HAVE_ARRAYS
+  /* support ordinary vectors even if arrays not available?  */
   else if (SCM_VECTORP (items))
     {
       len = SCM_LENGTH (items);
@@ -766,6 +772,7 @@ scm_sort (SCM items, SCM less)
 				    SCM_MAKINUM (len));
       return sortvec;
     }
+#endif
   else
     return scm_wta (items, (char *) SCM_ARG1, s_sort_x);
 }				/* scm_sort */
@@ -878,6 +885,8 @@ scm_stable_sort (SCM items, SCM less)
       items = scm_list_copy (items);
       return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
     }
+#ifdef HAVE_ARRAYS
+  /* support ordinary vectors even if arrays not available?  */
   else if (SCM_VECTORP (items))
     {
       SCM retvec;
@@ -896,6 +905,7 @@ scm_stable_sort (SCM items, SCM less)
       free (temp);
       return retvec;
     }
+#endif
   else
     return scm_wta (items, (char *) SCM_ARG1, s_stable_sort);
 }				/* scm_stable_sort */

libguile/tag.c

@@ -54,6 +54,8 @@ SCM_CONST_LONG (scm_utag_closure, "utag_closure", 3);
 SCM_CONST_LONG (scm_utag_symbol, "utag_symbol", 4);
 SCM_CONST_LONG (scm_utag_vector, "utag_vector", 5);
 SCM_CONST_LONG (scm_utag_wvect, "utag_wvect", 6);
+
+#ifdef HAVE_ARRAYS
 SCM_CONST_LONG (scm_utag_bvect, "utag_bvect", 7);
 SCM_CONST_LONG (scm_utag_byvect, "utag_byvect", 8);
 SCM_CONST_LONG (scm_utag_svect, "utag_svect", 9);
@@ -62,6 +64,8 @@ SCM_CONST_LONG (scm_utag_uvect, "utag_uvect", 11);
 SCM_CONST_LONG (scm_utag_fvect, "utag_fvect", 12);
 SCM_CONST_LONG (scm_utag_dvect, "utag_dvect", 13);
 SCM_CONST_LONG (scm_utag_cvect, "utag_cvect", 14);
+#endif 
+
 SCM_CONST_LONG (scm_utag_string, "utag_string", 15);
 SCM_CONST_LONG (scm_utag_substring, "utag_substring", 17);
 SCM_CONST_LONG (scm_utag_asubr, "utag_asubr", 19);
@@ -116,6 +120,8 @@ scm_tag (x)
 	  return SCM_CDR (scm_utag_vector) ;
 	case scm_tc7_wvect:
 	  return SCM_CDR (scm_utag_wvect) ;
+
+#ifdef HAVE_ARRAYS
 	case scm_tc7_bvect:
 	  return SCM_CDR (scm_utag_bvect) ;
 	case scm_tc7_byvect:
@@ -132,6 +138,8 @@ scm_tag (x)
 	  return SCM_CDR (scm_utag_dvect) ;
 	case scm_tc7_cvect:
 	  return SCM_CDR (scm_utag_cvect) ;
+#endif
+
 	case scm_tc7_string:
 	  return SCM_CDR (scm_utag_string) ;
 	case scm_tc7_substring:

libguile/tags.h

@@ -337,20 +337,24 @@ typedef long SCM;
  * into structs or smobs.  We need back some
  * of these 7 bit tags!
  */
-#define scm_tc7_llvect          29
 #define scm_tc7_pws		31
-#define scm_tc7_uvect		37
 #define scm_tc7_lvector		39
+
+#ifdef HAVE_ARRAYS
+#define scm_tc7_llvect          29
+#define scm_tc7_uvect		37
 #define scm_tc7_fvect		45
 #define scm_tc7_dvect		47
 #define scm_tc7_cvect		53
 #define scm_tc7_svect		55
-#define scm_tc7_contin		61
-#define scm_tc7_cclo		63
-#define scm_tc7_rpsubr		69
 #define scm_tc7_bvect		71
 #define scm_tc7_byvect		77
 #define scm_tc7_ivect		79
+#endif
+
+#define scm_tc7_contin		61
+#define scm_tc7_cclo		63
+#define scm_tc7_rpsubr		69
 #define scm_tc7_subr_0		85
 #define scm_tc7_subr_1		87
 #define scm_tc7_cxr		93

libguile/unif.c

@@ -73,105 +73,58 @@
 
 long scm_tc16_array;
 
-/* 
+/* return the size of an element in a uniform array or 0 if type not
- * This complicates things too much if allowed on any array.
+   found.  */
- * C code can safely call it on arrays known to be used in a single
+scm_sizet
- * threaded manner.
+scm_uniform_element_size (SCM obj)
- *
- * SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x); 
- */
-static char s_vector_set_length_x[] = "vector-set-length!";
-
-
-SCM 
-scm_vector_set_length_x (vect, len)
-     SCM vect;
-     SCM len;
 {
-  long l;
+  scm_sizet result;
-  scm_sizet siz;
-  scm_sizet sz;
 
-  l = SCM_INUM (len);
+  switch (SCM_TYP7 (obj))
-  SCM_ASRTGO (SCM_NIMP (vect), badarg1);
-  switch (SCM_TYP7 (vect))
     {
-    default:
-    badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
-    case scm_tc7_string:
-      SCM_ASRTGO (vect != scm_nullstr, badarg1);
-      sz = sizeof (char);
-      l++;
-      break;
-    case scm_tc7_vector:
-    case scm_tc7_wvect:
-      SCM_ASRTGO (vect != scm_nullvect, badarg1);
-      sz = sizeof (SCM);
-      break;
-#ifdef ARRAYS
     case scm_tc7_bvect:
-      l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
     case scm_tc7_uvect:
     case scm_tc7_ivect:
-      sz = sizeof (long);
+      result = sizeof (long);
       break;
+
     case scm_tc7_byvect:
-      sz = sizeof (char);
+      result = sizeof (char);
       break;
 
     case scm_tc7_svect:
-      sz = sizeof (short);
+      result = sizeof (short);
       break;
+
 #ifdef HAVE_LONG_LONGS
     case scm_tc7_llvect:
-      sz = sizeof (long_long);
+      result = sizeof (long_long);
       break;
 #endif 
 
 #ifdef SCM_FLOATS
 #ifdef SCM_SINGLES
     case scm_tc7_fvect:
-      sz = sizeof (float);
+      result = sizeof (float);
       break;
 #endif
+
     case scm_tc7_dvect:
-      sz = sizeof (double);
+      result = sizeof (double);
       break;
+
     case scm_tc7_cvect:
-      sz = 2 * sizeof (double);
+      result = 2 * sizeof (double);
       break;
 #endif
-#endif
+      
+    default:
+      result = 0;
     }
-  SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
+  return result;
-  if (!l)
-    l = 1L;
-  siz = l * sz;
-  if (siz != l * sz)
-    scm_wta (SCM_MAKINUM (l * sz), (char *) SCM_NALLOC, s_vector_set_length_x);
-  SCM_REDEFER_INTS;
-  SCM_SETCHARS (vect,
-	    ((char *)
-	     scm_must_realloc (SCM_CHARS (vect),
-			       (long) SCM_LENGTH (vect) * sz,
-			       (long) siz,
-			       s_vector_set_length_x)));
-  if (SCM_VECTORP (vect))
-    {
-      sz = SCM_LENGTH (vect);
-      while (l > sz)
-	SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
-    }
-  else if (SCM_STRINGP (vect))
-    SCM_CHARS (vect)[l - 1] = 0;
-  SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
-  SCM_REALLOW_INTS;
-  return vect;
 }
 
 
-#ifdef ARRAYS
-
 #ifdef SCM_FLOATS
 #ifdef SCM_SINGLES
 
@@ -2568,8 +2521,6 @@ freera (ptr)
   return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim);
 }
 
-/* This must be done after scm_init_scl() */
-
 void
 scm_init_unif ()
 {
@@ -2581,33 +2532,3 @@ scm_init_unif ()
   scm_add_feature ("array");
 #include "unif.x"
 }
-
-#else /* ARRAYS */
-
-
-int 
-scm_raprin1 (exp, port, pstate)
-     SCM exp;
-     SCM port;
-     scm_print_state *pstate;
-{
-  return 0;
-}
-
-
-SCM 
-scm_istr2bve (str, len)
-     char *str;
-     long len;
-{
-  return SCM_BOOL_F;
-}
-
-void 
-scm_init_unif ()
-{
-#include "unif.x"
-  scm_make_subr (s_resizuve, scm_tc7_subr_2, scm_vector_set_length_x);
-}
-
-#endif /* ARRAYS */

libguile/unif.h

@@ -74,7 +74,7 @@ extern long scm_tc16_array;
 
 
 
-extern SCM scm_vector_set_length_x SCM_P ((SCM vect, SCM len));
+extern scm_sizet scm_uniform_element_size (SCM obj);
 extern SCM scm_makflo SCM_P ((float x));
 extern SCM scm_make_uve SCM_P ((long k, SCM prot));
 extern SCM scm_uniform_vector_length SCM_P ((SCM v));

libguile/vectors.c

@@ -47,6 +47,76 @@
 #include "vectors.h"
 
 
+/* 
+ * This complicates things too much if allowed on any array.
+ * C code can safely call it on arrays known to be used in a single
+ * threaded manner.
+ *
+ * SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x); 
+ */
+static char s_vector_set_length_x[] = "vector-set-length!";
+
+
+SCM 
+scm_vector_set_length_x (vect, len)
+     SCM vect;
+     SCM len;
+{
+  long l;
+  scm_sizet siz;
+  scm_sizet sz;
+
+  l = SCM_INUM (len);
+  SCM_ASRTGO (SCM_NIMP (vect), badarg1);
+
+#ifdef HAVE_ARRAYS
+  if (SCM_TYP7 (vect) == scm_tc7_bvect)
+    {
+      l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
+    }
+  sz = scm_uniform_element_size (vect);
+  if (sz == 0)
+#endif
+  switch (SCM_TYP7 (vect))
+    {
+    default:
+    badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
+    case scm_tc7_string:
+      SCM_ASRTGO (vect != scm_nullstr, badarg1);
+      sz = sizeof (char);
+      l++;
+      break;
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
+      SCM_ASRTGO (vect != scm_nullvect, badarg1);
+      sz = sizeof (SCM);
+      break;
+    }
+  SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
+  if (!l)
+    l = 1L;
+  siz = l * sz;
+  if (siz != l * sz)
+    scm_wta (SCM_MAKINUM (l * sz), (char *) SCM_NALLOC, s_vector_set_length_x);
+  SCM_REDEFER_INTS;
+  SCM_SETCHARS (vect,
+	    ((char *)
+	     scm_must_realloc (SCM_CHARS (vect),
+			       (long) SCM_LENGTH (vect) * sz,
+			       (long) siz,
+			       s_vector_set_length_x)));
+  if (SCM_VECTORP (vect))
+    {
+      sz = SCM_LENGTH (vect);
+      while (l > sz)
+	SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
+    }
+  else if (SCM_STRINGP (vect))
+    SCM_CHARS (vect)[l - 1] = 0;
+  SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
+  SCM_REALLOW_INTS;
+  return vect;
+}
 
 SCM_PROC(s_vector_p, "vector?", 1, 0, 0, scm_vector_p);
 
@@ -263,5 +333,7 @@ void
 scm_init_vectors ()
 {
 #include "vectors.x"
+  /*
+    scm_make_subr (s_resizuve, scm_tc7_subr_2, scm_vector_set_length_x); */
 }
 

libguile/vectors.h

@@ -55,6 +55,7 @@
 
 
 
+extern SCM scm_vector_set_length_x SCM_P ((SCM vect, SCM len));
 extern SCM scm_vector_p SCM_P ((SCM x));
 extern SCM scm_vector_length SCM_P ((SCM v));
 extern SCM scm_vector SCM_P ((SCM l));