Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

correct the new list boxing and test it

  • Loading branch information...
commit 62cb3000843a072a3eda170145f38e7a1bd42734 1 parent e66775e
@ilitirit ilitirit authored
Showing with 18 additions and 8 deletions.
  1. +13 −6 src/box.lisp
  2. +1 −1  src/iterator.lisp
  3. +4 −1 t/box.lisp
View
19 src/box.lisp
@@ -42,7 +42,7 @@
do (setf new-tail (setf (cdr new-tail) (cons (car x) nil)))
(incf len)
finally (setf (cdr new-tail) (cons x nil)))
- (ptr (make-marray len :marray-class 'mm-array-as-list)))
+ (ptr (make-marray len :initial-contents new :marray-class 'mm-array-as-list)))
)
(t
(ptr (make-instance 'mm-cons :car (car cons) :cdr (cdr cons))))))
@@ -59,11 +59,18 @@
(defun unbox-array-as-list (index)
(with-pointer-slots (base length)
((mpointer tag index) mm-array-as-list)
- (let ((base base) (length length) (cons (cons nil nil)))
- (loop for i below (1- length)
- for tail = cons then (setf (cdr tail) (cons (mptr-to-lisp-object (dw (mptr-pointer base) i)) nil))
- finally (setf (cdr tail) (mptr-to-lisp-object (dw (mptr-pointer base) (1- length)))))
- cons))))
+ (let ((base base)
+ (length length))
+ (declare (inline elem))
+ (flet ((elem (n)
+ (mptr-to-lisp-object (dw (mptr-pointer base) n))))
+ (let*
+ ((cons (cons (elem 0) nil))
+ (tail cons))
+ (loop for i from 1 below (1- length)
+ do (setf tail (setf (cdr tail) (cons (elem i) nil)))
+ finally (setf (cdr tail) (elem (1- length))))
+ cons))))))
(defmacro prop-for-mm-symbol (sym)
`(get ,sym 'mm-symbol))
View
2  src/iterator.lisp
@@ -19,7 +19,7 @@
(decf ,last-index ,len)
(let ((,index ,(if reverse `,last-index `,first-index)))
(loop ,(if fresh-instances `for `with) ,var = (funcall ,instantiator ,index)
- do (locally ,@body)
+ do (let ,(when fresh-instances `((,var ,var))) ,@body)
(when (= ,index ,(if reverse `,first-index `,last-index))
(return))
(,(if reverse `decf `incf) ,index ,len)
View
5 t/box.lisp
@@ -17,7 +17,10 @@
(stefil:deftest box-cons-test ()
(loop repeat 10
for cons = nil then (cons cons nil)
- do (stefil:is (equal cons (box-unbox cons)))))
+ do (stefil:is (equal cons (box-unbox cons))))
+
+ (loop for list in '((1 2 box fail (x y)) (1 . 2) (((nil . 2))) (((1 2 3 (3)) 1) 1 2 2 . ( 1 2 . 3)) )
+ do (stefil:is (equal list (box-unbox list)))))
(stefil:deftest box-unspecialized-array-test ()
(loop for array in (list
Please sign in to comment.
Something went wrong with that request. Please try again.