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