[fset-cvs] r5 - trunk/Code

[sburson at common-lisp.net]

Author: sburson
Date: Sat May 26 02:34:37 2007
New Revision: 5

Modified:
   trunk/Code/defs.lisp
   trunk/Code/port.lisp
   trunk/Code/testing.lisp
   trunk/Code/tuples.lisp
Log:
Minor fixes for CMUCL, LispWorks, case-sensitive-lower mode.


Modified: trunk/Code/defs.lisp
==============================================================================
--- trunk/Code/defs.lisp	(original)
+++ trunk/Code/defs.lisp	Sat May 26 02:34:37 2007
@@ -29,7 +29,7 @@
 	   #:substitute #:substitute-if #:substitute-if-not
 	   #:some #:every #:notany #:notevery
 	   ;; This one is internal.
-	   #+(or cmucl scl sbcl) #:length)
+	   #+(or cmu scl sbcl) #:length)
   (:export #:set #:bag #:map #:seq #:tuple
 	   #:compare
 	   #:empty? #:size #:arb #:member? #:multiplicity

Modified: trunk/Code/port.lisp
==============================================================================
--- trunk/Code/port.lisp	(original)
+++ trunk/Code/port.lisp	Sat May 26 02:34:37 2007
@@ -11,17 +11,6 @@
 ;;; This license provides NO WARRANTY.
 
 
-#-lispworks
-(defun base-char-p (x)
-  (typep x 'base-char))
-
-;;; I think this may be faster than `(typep x 'base-char)'.  Maybe not.
-#+lispworks
-(defun base-char-p (x) (lw:base-char-p x))
-
-(declaim (inline base-char-p))
-
-
 ;;; On non-kernel-threads implementations, we use something like
 ;;; `without-interrupts'.  On kernel-threads implementations, we have to do
 ;;; real locking.
@@ -51,11 +40,11 @@
   (declare (ignore lock wait?))
   `(mp:without-interrupts . ,body))
 
-#+cmucl
+#+cmu
 (defun make-lock (&optional name)
   (declare (ignore name))
   nil)
-#+cmucl
+#+cmu
 (defmacro with-lock ((lock &key (wait? t)) &body body)
   (declare (ignore lock wait?))
   `(sys:without-interrupts . ,body))
@@ -122,6 +111,8 @@
   `(progn . ,body))
 
 
+;;; ----------------
+
 ;;; Constants used by the tuple implementation.  We choose the widths of
 ;;; two bitfields to fit in a fixnum less the sign bit.
 
@@ -146,6 +137,9 @@
     (23 9))
   "This limits the number of key/value pairs in any tuple.")
 
+
+;;; ----------------
+
 ;;; Unfortunately, CL doesn't specify that `make-random-state' should be able
 ;;; to accept an integer seed.  We want to be able to supply it one, so that
 ;;; (for testing) we can have multiple reproducible sequences of pseudorandom
@@ -153,7 +147,7 @@
 (defun make-seeded-random-state (seed)
   (if (null seed)
       (make-random-state)
-    #+(or cmucl scl)
+    #+(or cmu scl)
     (progn
       (assert (plusp seed))
       (kernel::make-random-object :state
@@ -168,20 +162,40 @@
 				  (logand seed #xFFFF))
     #+genera
     (fcli::make-random-state-internal 71 35 seed)
-    #-(or cmucl scl sbcl openmcl genera)
+    #-(or cmu scl sbcl openmcl genera)
     (error "Implementation-specific code needed in `make-seeded-random-state'")))
 
+
+;;; ----------------
+
+#-lispworks
+(defun base-char-p (x)
+  (typep x 'base-char))
+
+;;; I think this may be faster than `(typep x 'base-char)'.  Maybe not.
+#+lispworks
+(defun base-char-p (x) (lw:base-char-p x))
+
+#-lispworks
+(declaim (inline base-char-p))
+
+
 ;;; SBCL has a distinct `extended-char' type but no `make-char'.
 #+sbcl
 (defun make-char (code bits)
   ;; Kinda weird, but this is only used by the test suite to generate random chars.
   (code-char (+ code (ash bits 8))))
 
+#+lispworks
+(defun make-char (code bits)
+  (code-char code bits))
+
+
 ;;; This little oddity exists because of a limitation in Python (that's the
 ;;; CMUCL compiler).  Given a call to `length' on type `(or null simple-vector)',
 ;;; Python isn't quite smart enough to optimize the call unless we do the case
 ;;; breakdown for it like this.
-#+(or cmucl scl)
+#+(or cmu scl)
 (defmacro length (x)
   (ext:once-only ((x x))
     `(if (null ,x) 0 (cl:length ,x))))

Modified: trunk/Code/testing.lisp
==============================================================================
--- trunk/Code/testing.lisp	(original)
+++ trunk/Code/testing.lisp	Sat May 26 02:34:37 2007
@@ -16,7 +16,7 @@
   Value)
 
 
-(defun Run-Test-Suite (n-iterations &optional random-seed)
+(defun run-test-suite (n-iterations &optional random-seed)
   (let ((*random-state* (make-seeded-random-state random-seed))) ; for repeatability.
     (dotimes (i n-iterations)
       (Test-Map-Operations i (Test-Set-Operations i))

Modified: trunk/Code/tuples.lisp
==============================================================================
--- trunk/Code/tuples.lisp	(original)
+++ trunk/Code/tuples.lisp	Sat May 26 02:34:37 2007
@@ -218,7 +218,7 @@
     (unless desc
       (setq desc (Make-Tuple-Desc (empty-set) (vector)))
       (setf (lookup *Tuple-Descriptor-Map* (empty-map)) desc))
-  (make-tuple-internal desc (vector))))
+  (Make-Tuple-Internal desc (vector))))
 
 (defvar *Tuple-Random-Value* 0
   "State for an extremely fast, low-quality generator of small numbers of