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