[rucksack-devel] (no subject)
Леонид Новиков
ln at bk.ru
Mon Dec 17 22:38:40 EST 2007
I play with Rucksak and get this error:
CL-USER> (defvar *tmp-rucksack* #p"/tmp/tmp-rs/")
*TMP-RUCKSACK*
CL-USER> (rucksack:with-rucksack (rs *tmp-rucksack*)
(rucksack:with-transaction ()
(defclass plan-of-acc2 ()
((name :initform "1"
:accessor name
:index :string-index)
(accs :accessor accs))
(:metaclass rucksack:persistent-class)
(:index t))))
#<RUCKSACK:PERSISTENT-CLASS PLAN-OF-ACC2>
T
CL-USER> (rucksack:with-rucksack (rs *tmp-rucksack*)
(rucksack:with-transaction ()
(make-instance 'plan-of-acc2)
(rucksack:rucksack-map-class rs 'plan-of-acc2
(lambda (x)
(print (name x))))))
"1"
NIL
T
CL-USER> (rucksack:with-rucksack (rs *tmp-rucksack*)
(rucksack:with-transaction ()
(rucksack:rucksack-map-class rs 'plan-of-acc2
(lambda (x)
(setf (name x) "w")))))
Argument X is not a NUMBER: NIL
[Condition of type SIMPLE-TYPE-ERROR]
Restarts:
0: [ABORT] Abort #<RUCKSACK:STANDARD-TRANSACTION #340689439800000 with 1 dirty object>
1: [RETRY] Retry #<RUCKSACK:STANDARD-TRANSACTION #340689439800000 with 1 dirty object>
2: [ABORT] Return to SLIME's top level.
3: [CLOSE-CONNECTION] Close SLIME connection
4: [ABORT] Exit debugger, returning to top level.
Backtrace:
0: (SB-KERNEL:TWO-ARG-= NIL 0)
1: (RUCKSACK::LEAF-DELETE-KEY
#<RUCKSACK:BTREE #23 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
#<RUCKSACK:BTREE-NODE with 1 bindings {CE98CF1}>
(#<RUCKSACK:BTREE-NODE with 2 bindings {CE984B9}> NIL)
"1"
:IGNORE)
2: ((SB-PCL::FAST-METHOD RUCKSACK:BTREE-DELETE
(RUCKSACK:BTREE #1="#<...>" . #1#))
(#(NIL) . #())
#<unavailable argument>
#<RUCKSACK:BTREE #23 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
"1"
34)
3: ((SB-PCL::FAST-METHOD RUCKSACK:RUCKSACK-MAYBE-INDEX-CHANGED-SLOT
(RUCKSACK:STANDARD-RUCKSACK T T T T T T T))
#<unavailable argument>
#<unavailable argument>
#<RUCKSACK::SERIAL-TRANSACTION-RUCKSACK in #P"\\tmp\\tmp-rs\\" with 0 roots {CE3C511}>
#<RUCKSACK:PERSISTENT-CLASS PLAN-OF-ACC2>
#<PLAN-OF-ACC2 #34 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
#<RUCKSACK::PERSISTENT-EFFECTIVE-SLOT-DEFINITION NAME>
"1"
"w" ..)
4: ((SB-PCL::FAST-METHOD (SETF SB-MOP:SLOT-VALUE-USING-CLASS) :AROUND
(T RUCKSACK:PERSISTENT-CLASS T T))
#<unavailable argument>
#<CLOSURE (LAMBDA #) {D335ABD}>
"w"
#<RUCKSACK:PERSISTENT-CLASS PLAN-OF-ACC2>
#<PLAN-OF-ACC2 #34 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
#<RUCKSACK::PERSISTENT-EFFECTIVE-SLOT-DEFINITION NAME>)
5: (SB-PCL::SET-SLOT-VALUE
#<PLAN-OF-ACC2 #34 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
NAME
"w")
6: ((SB-PCL::FAST-METHOD RUCKSACK::MAP-BTREE-KEYS-FOR-NODE
(RUCKSACK:BTREE RUCKSACK:BTREE-NODE T T T T T T))
#<unavailable argument>
#<unavailable argument>
#<RUCKSACK:BTREE #1 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
#<RUCKSACK:BTREE-NODE with 1 bindings {CE91459}>
#<CLOSURE (LAMBDA #) {CE9033D}>
NIL
NIL
NIL ..)
7: ((SB-PCL::FAST-METHOD RUCKSACK::MAP-BTREE-KEYS-FOR-NODE
(RUCKSACK:BTREE RUCKSACK:BTREE-NODE T T T T T T))
#<unavailable argument>
#<unavailable argument>
#<RUCKSACK:BTREE #1 in #<STANDARD-CACHE of size 10000, heap #P"e:\\tmp\\tmp-rs\\heap" and 39 objects in memory.>>
#<RUCKSACK:BTREE-NODE with 2 bindings {CE90C61}>
#<CLOSURE (LAMBDA #) {CE9033D}>
NIL
NIL
NIL ..)
8: ((LABELS RUCKSACK::MAP-INSTANCES) PLAN-OF-ACC2)
9: ((SB-PCL::FAST-METHOD RUCKSACK:RUCKSACK-MAP-CLASS
(RUCKSACK:STANDARD-RUCKSACK #1="#<...>" . #1#))
#<unavailable argument>
#<unavailable argument>
#<RUCKSACK::SERIAL-TRANSACTION-RUCKSACK in #P"\\tmp\\tmp-rs\\" with 0 roots {CE3C511}>
PLAN-OF-ACC2
#<FUNCTION (LAMBDA #) {CE30A25}>)
This patch will possible allow to avoid such behaviours.
-------------- next part --------------
*** e:/src/lisp/lib/rucksack-orig/p-btrees.lisp Sun Aug 12 13:01:14 2007
--- e:/src/lisp/lib/rucksack/p-btrees.lisp Mon Dec 17 15:47:17 2007
***************
*** 868,883 ****
(ecase if-does-not-exist
(:ignore (return-from leaf-delete-key))
(:error (error 'btree-search-error :btree btree :key key))))
!
! (let* ((position (key-position key leaf))
(length (btree-node-index-count leaf))
(was-biggest-key-p (= position (1- length))))
!
! (remove-key leaf (binding-key binding))
!
(unless (node-full-enough-p btree leaf)
(enlarge-node btree leaf parent-stack))
-
(when was-biggest-key-p
(unless (= 0 (btree-node-index-count leaf))
(update-parents-for-deleted-key btree parent-stack key (biggest-key leaf)))))))
--- 868,879 ----
(ecase if-does-not-exist
(:ignore (return-from leaf-delete-key))
(:error (error 'btree-search-error :btree btree :key key))))
! (let* ((position (key-position key leaf :test (btree-key= btree)))
(length (btree-node-index-count leaf))
(was-biggest-key-p (= position (1- length))))
! (remove-key leaf (binding-key binding) :test (btree-key= btree))
(unless (node-full-enough-p btree leaf)
(enlarge-node btree leaf parent-stack))
(when was-biggest-key-p
(unless (= 0 (btree-node-index-count leaf))
(update-parents-for-deleted-key btree parent-stack key (biggest-key leaf)))))))
***************
*** 915,921 ****
(when parent-stack
(let ((node (first parent-stack)))
(when node
! (let ((position (key-position old-key node)))
(when position
(setf (binding-key (node-binding node position))
new-key)
--- 911,917 ----
(when parent-stack
(let ((node (first parent-stack)))
(when node
! (let ((position (key-position old-key node :test (btree-key= btree))))
(when position
(setf (binding-key (node-binding node position))
new-key)
***************
*** 978,984 ****
:start1 left-length
:start2 0 :end2 right-length)
;; Remove key which pointed to LEFT-NODE.
! (remove-key parent (binding-key left-binding))
;; Make binding which pointed to RIGHT-NODE point to LEFT-NODE.
(setf (binding-value right-binding) left-node)
;; Set new length of LEFT-NODE.
--- 974,980 ----
:start1 left-length
:start2 0 :end2 right-length)
;; Remove key which pointed to LEFT-NODE.
! (remove-key parent (binding-key left-binding) :test (btree-key= btree))
;; Make binding which pointed to RIGHT-NODE point to LEFT-NODE.
(setf (binding-value right-binding) left-node)
;; Set new length of LEFT-NODE.
***************
*** 1002,1009 ****
do (setf (node-binding node i) nil))
(setf (btree-node-index-count node) new-length))
! (defun remove-key (node key)
! (let ((position (key-position key node))
(length (btree-node-index-count node)))
(unless (>= position (1- length))
;; Move bindings to the left.
--- 998,1005 ----
do (setf (node-binding node i) nil))
(setf (btree-node-index-count node) new-length))
! (defun remove-key (node key &key test)
! (let ((position (key-position key node :test test))
(length (btree-node-index-count node)))
(unless (>= position (1- length))
;; Move bindings to the left.
***************
*** 1013,1021 ****
:start2 (1+ position) :end2 length)))
(shorten node (1- length))))
! (defun key-position (key node)
(p-position key (btree-node-index node)
:key #'binding-key
:end (btree-node-index-count node)))
(defun node-full-enough-p (btree node)
--- 1009,1018 ----
:start2 (1+ position) :end2 length)))
(shorten node (1- length))))
! (defun key-position (key node &key test)
(p-position key (btree-node-index node)
:key #'binding-key
+ :test test
:end (btree-node-index-count node)))
(defun node-full-enough-p (btree node)
More information about the rucksack-devel
mailing list