Permalink
Browse files

remove need for anaphora; it just couldn't take it (snicker).

  • Loading branch information...
1 parent 0ac869d commit 07d9f85465cc5e4bc081ad3a0853582278809f0d Gary King committed Dec 21, 2010
@@ -149,29 +149,29 @@ this allows the user to make 'nicknames' for items in a list."
(sbuff (subseq string 0 (min (1+ end) (length string))))
la hour minute (second 0) (seq '(:h :m :s)))
(loop until (string= sbuff "") do
- (setq la (min (or (position #\: sbuff) end)
- (or (position #\. sbuff) end)
- (length sbuff)))
- (case (pop seq)
- (:h (setq hour (read-from-string (subseq sbuff 0 la))))
- (:m (setq minute (read-from-string (subseq sbuff 0 la))))
- (:s (setq second (read-from-string (subseq sbuff 0 la))))
- (t (error "unrecognized time format in ~S" string)))
- (setq sbuff (subseq sbuff (min (1+ la) (length sbuff)) (length sbuff))))
+ (setq la (min (or (position #\: sbuff) end)
+ (or (position #\. sbuff) end)
+ (length sbuff)))
+ (case (pop seq)
+ (:h (setq hour (read-from-string (subseq sbuff 0 la))))
+ (:m (setq minute (read-from-string (subseq sbuff 0 la))))
+ (:s (setq second (read-from-string (subseq sbuff 0 la))))
+ (t (error "unrecognized time format in ~S" string)))
+ (setq sbuff (subseq sbuff (min (1+ la) (length sbuff)) (length sbuff))))
(unless (and hour minute second)
(error "incomplete time format in ~S" string))
;; Handle "midnight, noon, and 12 AM, 12 PM weirdness
(cond ((search "noon" string :test #'string-equal)
(assert (= hour 12) () "12 is the only hour you can use with NOON")
(assert (and (= second 0)
(= minute 0)) () "~2d:~2d:~2d NOON makes no sense"
- hour minute second)
+ hour minute second)
(setf hour 12))
((search "midnight" string :test #'string-equal)
(assert (= hour 12) () "12 is the only hour you can use with MIDNIGHT")
(assert (and (= second 0)
(= minute 0)) () "~2d:~2d:~2d MIDNIGHT makes no sense"
- hour minute second)
+ hour minute second)
(setf hour 0))
((search "AM" string :test #'string-equal)
;; 12 AM is a bad use of AM - should use Midnight, but we allow it
@@ -186,15 +186,16 @@ this allows the user to make 'nicknames' for items in a list."
(incf hour 12)))
(t nil))
(values (list hour minute second)
- (acond ((search "PM" string :test #'string-equal)
- (+ it 2))
- ((search "AM" string :test #'string-equal)
- (+ it 2))
- ((search "midnight" string :test #'string-equal)
- (+ it 8))
- ((search "noon" string :test #'string-equal)
- (+ it 4))
- (t end)))))
+ (let ((it 0))
+ (cond ((setf it (search "PM" string :test #'string-equal))
+ (+ it 2))
+ ((setf it (search "AM" string :test #'string-equal))
+ (+ it 2))
+ ((setf it (search "midnight" string :test #'string-equal))
+ (+ it 8))
+ ((setf it (search "noon" string :test #'string-equal))
+ (+ it 4))
+ (t end))))))
(defun read-date (string &optional default-year)
"strips the date signature off of the front of string. can handle slash-delimited format:
@@ -572,7 +573,8 @@ for \"never\" or variations, nil is returned."
(if err (error "~a: ~a" string err) val))))))
(defun parse-time (string &optional (allow-intervals? t))
- (aif (search "from" string :test #'string-equal)
+ (let ((it (search "from" string :test #'string-equal)))
+ (if it
(+ (parse-interval-or-never (subseq string 0 it))
(if (search "now" (subseq string (+ it 4)) :test #'string-equal)
(get-universal-time)
@@ -583,7 +585,7 @@ for \"never\" or variations, nil is returned."
(parse-date-and-time-string string t)
(if allow-intervals?
(parse-interval-or-never string)
- (error "~a is not parseable" string))))))
+ (error "~a is not parseable" string)))))))
#+LATER
(defun print-interval-or-never (val &optional (stream t))
@@ -681,4 +683,4 @@ if stream is nil, construct and return a string."
;;; ***************************************************************************
;;; * End of File *
-;;; ***************************************************************************
+;;; ***************************************************************************
View
@@ -416,20 +416,21 @@ source."
(list #\/ #\* #\\ #\ #\< #\> #\@ #\. #\: #\( #\) #\& #\ ))
(defun ensure-filename-safe-for-os (name)
- (let* ((array (make-array (* 2 (length name)) :fill-pointer 0 :adjustable t)))
+ (let* ((array (make-array (* 2 (length name)) :fill-pointer 0 :adjustable t))
+ it)
(labels ((add-char (ch)
(vector-push-extend ch array))
(escape-char (index)
(add-char #\-)
(add-char (code-char (+ (char-code #\a) index)))))
(loop for ch across name do
- (acond ((char-equal ch #\-)
- (add-char #\-)
- (add-char #\-))
- ((position ch *filename-escape-characters*)
- (escape-char (1+ it)))
- (t
- (add-char ch))))
+ (cond ((char-equal ch #\-)
+ (add-char #\-)
+ (add-char #\-))
+ ((setf it (position ch *filename-escape-characters*))
+ (escape-char (1+ it)))
+ (t
+ (add-char ch))))
(coerce array 'string))))
;; we may want to conditionalize on OS here...
@@ -265,7 +265,7 @@ Ex.
;;; ---------------------------------------------------------------------------
-
+#|
(defun match (x y &optional binds)
(acond2
((or (eql x y) (eql x '_) (eql y '_)) (values binds t))
@@ -301,7 +301,7 @@ Ex.
(if (varsym? expr) (list expr))
(union (vars-in (car expr) atom?)
(vars-in (cdr expr) atom?))))
-
+|#
;;; ***************************************************************************
;;; * End of File *
@@ -9,9 +9,10 @@
(min-bias 0.5)
(max-bias 0.5))
(when (not trust-me?)
- (awhen (or (and (eq (funcall predicate min) t) min)
- (and (eq (funcall predicate max) t) max))
- (return-from binary-search (values it :exact))))
+ (let ((it (or (and (eq (funcall predicate min) t) min)
+ (and (eq (funcall predicate max) t) max))))
+ (when it
+ (return-from binary-search (values it :exact)))))
(unless trust-me?
(assert (eq (funcall predicate min) :higher) nil
@@ -161,7 +161,7 @@ deleted items, and the new sequence."
"Destructively compacts an array with fill-pointer. Works on type T
arrays and considers elements with Nil in them to be empty."
(declare (array array))
- (let* ((next-index-to-fill (aif (position nil array :test #'eq) it -1))
+ (let* ((next-index-to-fill (or (position nil array :test #'eq) -1))
(scan-index next-index-to-fill)
(length (length array)))
(declare (fixnum next-index-to-fill scan-index length))
@@ -325,7 +325,7 @@ fractional part of the float must be zero or an error is signalled."
;; large lists.
(defun sort-using-list-order (x list &key (test #'eq) key (list-key #'identity))
"Sorts the list `x' using the other list `list' as a index."
- (flet ((item-lessp-function (list test item-key list-key)
+ (flet ((item-lessp-function (list test item-key list-key)
(if item-key
#'(lambda (item-1 item-2)
(setf item-2 (funcall item-key item-2)
@@ -671,7 +671,7 @@ of the curry."
(remove-duplicates
(loop for superclass in (direct-superclasses-defclass* class-name) nconc
(append (ensure-list superclass)
- (awhen (superclasses-defclass* superclass) it)))))
+ (superclasses-defclass* superclass)))))
;;; ---------------------------------------------------------------------------
View
@@ -39,12 +39,10 @@ instructions."))
:directory '(:relative "dev" "utilities"))
:components
((:file "package-additional")
- (:file "anaphoric"
- :depends-on ("package-additional"))
(:file "graham"
- :depends-on ("anaphoric" "package-additional"))
+ :depends-on ("package-additional"))
(:file "dates-and-times"
- :depends-on ("macros" "anaphoric" "package-additional"))
+ :depends-on ("macros" "package-additional"))
(:file "files"
:depends-on ("graham" "macros"))
(:file "macros"

0 comments on commit 07d9f85

Please sign in to comment.