Re: (setf (readtable-case *readtable*) :invert) completely preserves symbol case in CMUCL

[WJ]

Erik Naggum wrote:

> (defun invert-string (string)
> (declare (optimize (speed 3) (safety 0))
> (simple-string string))
> (check-type string 'string)
> (prog ((invert nil)
> (index 0)
> (length (length string)))
> (declare (simple-string invert)
> (type (integer 0 65536) index length))
> unknown-case
> (cond ((= index length)
> (return string))
> ((upper-case-p (schar string index))
> (when (and (/= (1+ index) length)
> (lower-case-p (schar string (1+ index))))
> (return string))
> (setq invert (copy-seq string))
> (go upper-case))
> ((lower-case-p (schar string index))
> (setq invert (copy-seq string))
> (go lower-case))
> (t
> (incf index)
> (go unknown-case)))
> upper-case
> (setf (schar invert index) (char-downcase (schar invert index)))
> (incf index)
> (cond ((= index length)
> (return invert))
> ((lower-case-p (schar invert index))
> (return string))
> (t
> (go upper-case)))
> lower-case
> (setf (schar invert index) (char-upcase (schar invert index)))
> (incf index)
> (cond ((= index length)
> (return invert))
> ((upper-case-p (schar invert index))
> (return string))
> (t
> (go lower-case)))))


Absolutely incredible. I guess the pitiful little guy thought that he
had to cobble together that hideous mess in order to avoid
traversing the string more than once.

And that bonehead was considered a Commune Lisp guru.
Tells you a lot about Commune "Lisp", doesn't it?


Clojure:

;; Traverses the string no more than once.
(defn can-invert [[chr & more] prev-case result]
(if-not chr
result
(let [chr-case (cond (Character/isUpperCase chr) 'up
(Character/isLowerCase chr) 'low
true false)]
(cond
(and prev-case chr-case (not= prev-case chr-case)) false
(= 'up chr-case)
(can-invert more chr-case (str result (Character/toLowerCase chr)))
(= 'low chr-case)
(can-invert more chr-case (str result (Character/toUpperCase chr)))
true (can-invert more prev-case (str result chr))))))

(defn invert-string [string]
(or (can-invert string nil "") string))


user=> (invert-string "UPPER")
"upper"
user=> (invert-string "lower")
"LOWER"
user=> (invert-string "Mixed")
"Mixed"
user=> (invert-string "2-q-4-a")
"2-Q-4-A"
user=> (invert-string "2-q-4-A")
"2-q-4-A"

[Raymond Wiker]

He was obviously concerned with efficiency, so he didn't fall into the
trap of coding a tail-recursive solution in language without tail-call
optimization.