db steps

parent 2fdde97d
......@@ -3,8 +3,8 @@
#:export ())
(define vlist-base (@@ (logic guile-log code-load) clist-base))
(define vlist-offset (@@ (logic guile-log code-load) clist-offset))
(define vlist-base (@@ (logic guile-log code-load) vlist-base))
(define vlist-offset (@@ (logic guile-log code-load) vlist-offset))
elts[0] = first;
......@@ -311,6 +311,17 @@ elts[4] = my_scm_from_int(0);
(hash-set! vlists vlist vid)
(define (pull-vhash db kf)
(let ((vlists (slot-ref db 'vhash)))
(aif it (hash-ref vlists vlist)
(let* ((tableid (add-table sb
(vlist-base vlist)
(vlist-offset vlist)))
(vid (db-write-vhash db tableif (vlist-offset vlist))))
(hash-set! vlists vlist vid)
(define (add-table db table offset)
(let* ((tables (slot-ref db 'tables))
(tn (table-size table)))
......@@ -363,39 +374,19 @@ elts[4] = my_scm_from_int(0);
(db-write-table-entryl db dbtable (add-data db (car l)))
(lp (cdr l)))))
;; Tree
(define (add-tree db x)
(if (vector? x)
(let ((nodes (slot-ref db 'nodes)))
(aif it (hashq-ref nodes x)
(car it)
(let ((car-key (add-tree db (tree-car x)))
(cdr-key (add-tree db (tree-cdr x)))
(var-key (add-data db (tree-var x)))
(str-key (add-vhash db (tree-str x)))
(atm-key (add-vhash db (tree-atm x)))
(db-write-node db car-key cdr-key var-key str-key atm-key)))
(hashq-set! nodes x (list key car-key cdr-key var-key str-key atm-key))
;; env
(define (add-env db env)
(let ((envs (slot-ref db 'envs)))
(aif it (hashq-ref envs env)
(car it)
(let* ((f (vector-ref env 0))
(dyn (vector-ref env 1))
(let* ((dyn (cdr (vector-ref env 1)))
(vec (vector-ref env 2))
(tre (vector-ref env 3))
(kf (add-data db f))
(kdyn (add-data db dyn))
(kdyn (add-vhash db dyn))
(kvec (add-vlist db vec))
(ktre (add-tree db tre))
(db-write-env db kf kdyn kvec ktre)))
(hashq-set! envs db (list key kf kdyn kvec ktre))
(db-write-env db kdyn kvec)))
(hashq-set! envs db (list key kdyn kvec))
;; Predicate
......@@ -417,38 +408,31 @@ elts[4] = my_scm_from_int(0);
;;;; ======================= PULL ==========================
(define (pull-tree db)
(let ((nodes (slot-ref db 'nodes))
(rnodes (slot-ref db 'rnodes))
(nnodes (slot-ref db 'nnodes)))
(let lp ((rows (db-pull-tree db nnodes)) (n nnodes))
(define (pull-vlist db k)
(define (lookup-env db kdyn kvec f add)
(let ((s (fluid-ref *current-stack*)))
(let lp ((rows (pull-vlist db kvec)))
(match rows
(((key ca cd va at st) . rows)
(let* ((xca (lookup-tree ca))
(xcd (lookup-tree cd))
(xva (lookup-data va))
(xat (lookup-vhash at))
(xst (lookup-vhash st))
(x (vector xca xcd xva xat xst)))
(hashq-set! nodes x key)
(hash-set! rnodes key x)
(lp rows (+ n 1))))
(slot-set! db nnodes n))))))
((#(t a b c g) . rows)
(add s f a b c g)
(lp rows))))
(let lp ((rows (pull-vhash db kdyn)))
(match rows
(((k v) . rows)
(dynamic-remove-index f k)
(lp rows))))))
(define (pull-env db env key)
(define (pull-env s db env key f add ref)
(let ((envs (slot-ref db 'envs)))
(define (pull)
(match (db-pull-env db key)
((key2 kf kdyn kvec ktre)
(let ((env (vector
(lookup-data db kf)
(lookup-data db kdyn)
(lookup-vlist db kvec)
(lookup-tree db ktre))))
(hashq-set! envs env (vector key2 kf kdyn kvec ktre))
((key2 kdyn kvec)
(lookup-env db kdyn kvec f add)
(let ((env (ref (get-env f))))
(hashq-set! envs env (vector key2 kdyn kvec))))))
(aif it (hashq-ref env envs)
(if (eq? (car it) key)
......@@ -467,8 +451,8 @@ elts[4] = my_scm_from_int(0);
(db-pull-predicate-all db (pull-data db f) (pull-module db dir)))))
(if (pair? l)
(let ((x (car l)))
(let ((env (cons (pull-env db (car env) (list-ref x 3))
(pull-env db (cdr env) (list-ref x 4)))))
(hashq-set! envs env x)
(set-env f env)))))
(pull-env db (car env) (list-ref x 3) f dynmaic-push car)
(pull-env db (cdr env) (list-ref x 4) f dynamic-append cdr)
(let ((env (get-env f)))
(hashq-set! envs env x)))))))
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