Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

zipを少し最適化

  • Loading branch information...
commit 95b1db8dca550bcaadeedde1274be74e4b0bea25 1 parent 3cd05d9
@sile authored
Showing with 27 additions and 21 deletions.
  1. +27 −21 loop.lisp
View
48 loop.lisp
@@ -44,34 +44,40 @@
(declare (function loop1 loop2))
(multiple-value-bind (start1 update-fn1 end-fn1 apply-fn1) (funcall loop1)
(multiple-value-bind (start2 update-fn2 end-fn2 apply-fn2) (funcall loop2)
- (let ((prev1 undef)
- (prev2 undef))
+ (let ((cur1 start1)
+ (cur2 start2)
+ (memo1 undef)
+ (memo2 undef))
(lambda ()
- (values (cons start1 start2)
+ (values t
(lambda (pair)
- (cons (if (eq prev1 undef) (funcall update-fn1 (car pair)) (car pair))
- (if (eq prev2 undef) (funcall update-fn2 (cdr pair)) (cdr pair))))
+ (declare (ignore pair))
+ (when (eq memo1 undef)
+ (setf cur1 (funcall update-fn1 cur1)))
+ (when (eq memo2 undef)
+ (setf cur2 (funcall update-fn2 cur2))))
(lambda (pair)
- (or (funcall end-fn1 (car pair))
- (funcall end-fn2 (cdr pair))))
+ (declare (ignore pair))
+ (or (funcall end-fn1 cur1)
+ (funcall end-fn2 cur2)))
(lambda (fn)
- (lambda (cur)
- (block :outer
- (when (eq prev1 undef)
- (funcall (funcall apply-fn1 (lambda (cur) (setf prev1 cur))) (car cur))
- (when (eq prev1 undef)
- (return-from :outer)))
- (when (eq prev2 undef)
- (funcall (funcall apply-fn2 (lambda (cur) (setf prev2 cur))) (cdr cur))
- (when (eq prev2 undef)
- (return-from :outer)))
- (funcall fn (cons prev1 prev2))
- (setf prev1 undef
- prev2 undef))))
+ (lambda (pair)
+ (declare (ignore pair))
+ (when (eq memo1 undef)
+ (funcall (funcall apply-fn1 (lambda (cur) (setf memo1 cur))) cur1))
+
+ (when (eq memo2 undef)
+ (funcall (funcall apply-fn2 (lambda (cur) (setf memo2 cur))) cur2))
+
+ (when (not (or (eq memo1 undef)
+ (eq memo2 undef)))
+ (funcall fn (cons memo1 memo2))
+ (setf memo1 undef
+ memo2 undef))))
))))))
(declaim (inline each))
-(defun each (fn loop)
+(defun each (fn loop)
(declare (function loop))
(multiple-value-bind (start update-fn end-fn apply-fn) (funcall loop)
(declare (function update-fn end-fn apply-fn))
Please sign in to comment.
Something went wrong with that request. Please try again.