db steps

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