db improvements

parent 53b4ea99
This diff is collapsed.
......@@ -968,7 +968,8 @@ add/run * vlist *
(define* (make-functional-dynamic-db #:optional (raw? #f))
(define (make-1)
(vector (make-bitmap-tag) (make-dynlist) #f #f))
(vector (make-bitmap-tag) (cons (make-dynlist) vlist-null) #f #f))
(define (make) (cons (make-1) (make-1)))
(define (p x) (if (and (procedure? x)
......@@ -983,8 +984,8 @@ add/run * vlist *
(define (insert s i a f c g)
(let* ((e (fluid-ref env))
(data (append
(dynlist->list (get-dyn (car e)))
(reverse (dynlist->list (get-dyn (cdr e))))))
(dynlist->list (car (get-dyn (car e))))
(reverse (dynlist->list (car (get-dyn (cdr e)))))))
(data (let lp ((j 0) (l data) (r '()))
(if (= j i)
(let lp2 ((r r) (rr (cons (vector 0 a f c g) l)))
......@@ -1008,7 +1009,8 @@ add/run * vlist *
(define (add-raw s a f c e g)
(let* ((t5 (get-tag e))
(t0 (tag-it t5))
(d (get-dyn e))
(d (car (get-dyn e)))
(rem (cdr (get-dyn e)))
(ar (get-ar e))
(l (get-li e))
(set (get-theory e))
......@@ -1021,7 +1023,7 @@ add/run * vlist *
(values
(vector (next-bitmap-tag t5)
(dynlist-add d data)
(cons (dynlist-add d data) rem)
(my-list-add ar data)
(if l (bitmap-indexer-add s a t0 l (mk-get-set set)) l)
set)
......@@ -1097,7 +1099,8 @@ add/run * vlist *
(define (rm-raw s f e one? g)
(let* ((t1 (get-tag e))
(d (get-dyn e))
(d (car (get-dyn e)))
(rem (cdr (get-dyn e)))
(ar (get-ar e))
(l (get-li e))
(rems '())
......@@ -1121,7 +1124,14 @@ add/run * vlist *
(t0 (get-t data)))
(set! t1 (cons t0 t1))
(index-remove s t0 (get-a data) i)))))))
(define (add)
(let lp ((rems rems) (rem rem))
(if (pair? rems)
(let ((t (get-tag (car rems))))
(lp (cdr rems) (vhash-cons t #t rem)))
rem)))
(call-with-values (lambda () (dynlist-remove f d one?))
(lambda (tree change?)
(fold-dynlist-rl (lambda (x e) (get-a x)) tree 0)
......@@ -1132,7 +1142,7 @@ add/run * vlist *
tree
(make-1))
(let ((ll (remove l rems)))
(vector t1 tree ar ll)))))))
(vector t1 (cons tree (add)) ar ll)))))))
(define (rm s f one? g)
(let* ((e (fluid-ref env))
......@@ -1161,7 +1171,7 @@ add/run * vlist *
(set-c a (p (get-c a))))
(define (compile-raw e)
(let* ((l (get-dyn e))
(let* ((l (car (get-dyn e)))
(m (fold-dynlist-lr (lambda (x seed)
(max seed (max-t (get-t x))))
l 0))
......@@ -1193,7 +1203,7 @@ add/run * vlist *
(compile-raw er) (get-li er)))))
(define (compile-index-raw s e)
(let* ((d (get-dyn e))
(let* ((d (car (get-dyn e)))
(set 0)
(dyn (fold-dynlist-lr
(lambda (x indexer)
......@@ -1205,7 +1215,7 @@ add/run * vlist *
(set! set (compile-set-representation set))
(vector
(get-tag e)
d
(get-dyn e)
(dynlist->vlist (get-ar e) d)
(compile-inh s dyn set)
set)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment