elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[elephant-cvs] CVS elephant
by ieslick 09 Mar '07

09 Mar '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv2630 Modified Files: TODO Log Message: Fixed migrate bug that created new dst objects for each src persistent object --- /project/elephant/cvsroot/elephant/TODO 2007/03/08 21:29:53 1.67 +++ /project/elephant/cvsroot/elephant/TODO 2007/03/09 00:44:35 1.68 @@ -15,7 +15,6 @@ - Validate SQL migration 0.6.0->0.6.1 (Robert) Stability and Performance: -- Migration: Validate that migrate can use either O(c) or O(n/c) where c << n memory for large DBs - Migration: Improve support for nested persistent objects inside standard objects, arrays, etc? - Migration: Improve scaling properties of migration so all objects do not need to be resident in memory? - Migration: Validate that graph structures with loop are copied properly @@ -27,7 +26,6 @@ - Validate OpenMCL 1.1 and/or 64-bit on Mac OS X? - 64-bit lisp verification - Verify db_deadlock for other lisps (launch and kill background program I/F) - sbcl and allegro are OK Test coverage: - Clean up interface to tests @@ -84,6 +82,8 @@ x Tests to validate new map interfaces on top of existing tests (Ian) x Added support and tests for serializing structure objects on all supported platforms (Ian) x Fixed cygwin-ming32 -mno-cygwin build for Windows for Lispworks and Allegro (Frank, Ian) +x Migration: Validate that migrate can use either O(c) or O(n*c) where c approaches 0 memory for large DBs + Uses O(n*c) where C is the cost to store a persistent object reference and old oid reference DEVELOPMENT CHECKINS:

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 09 Mar '07

09 Mar '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv2630/src/elephant Modified Files: migrate.lisp Log Message: Fixed migrate bug that created new dst objects for each src persistent object --- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/02/26 19:12:18 1.9 +++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/03/09 00:44:35 1.10 @@ -48,10 +48,11 @@ ;; other way to do comparisons between objects across stores (different ;; oid namespaces) so user beware of the pitfalls of partial migrations... ;; -;; - Migrate keeps a memory-resident hash of all objects; this means -;; you cannot currently migrate a store that has more data than your -;; main memory. (This could be fixed by keeping the oid table in -;; the target store and deleting it on completion) +;; - Migrate keeps a memory-resident hash of all persistent objects; +;; this is not as bad as it sounds as an object is only an oid reference +;; and a pointer to the store controller it belongs to. However, you +;; may eventually run out of heap space for very large DB's. We can use +;; the old DB to store the mappings if this becomes a problem. ;; ;; - Migration does not maintain OID equivalence so any datastructures which ;; index into those will have to have a way to reconstruct themselves (better @@ -73,6 +74,7 @@ ;; + (defgeneric migrate (dst src) (:documentation "Migrate an object from the src object, collection or controller @@ -96,7 +98,7 @@ ;; ERROR CHECKING -(defmethod migrate :around ((dst store-controller) (src t)) +(defmethod migrate :around ((dst store-controller) (src store-controller)) "This method ensures that we wipe our duplication detection around any top level call to migrate" (if *migrating*

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv17545/tests Modified Files: testindexing.lisp Log Message: A few details to go green on sbcl and acl on mac32 --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/08 19:50:20 1.34 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/08 21:29:53 1.35 @@ -105,8 +105,8 @@ (deftest indexing-class-opt (progn (when (class-indexedp-by-name 'idx-cslot) - (disable-class-indexing 'idx-cslot :errorp nil) - (setf (find-class 'idx-cslot) nil)) + (disable-class-indexing 'idx-cslot :errorp nil)) + (setf (find-class 'idx-cslot) nil) (defclass idx-cslot () ((slot1 :initarg :slot1 :initform 0 :accessor slot1)) @@ -227,9 +227,9 @@ (deftest indexing-wipe-index (progn - (when (class-indexedp-by-name 'idx-five-del ) - (disable-class-indexing 'idx-five-del :errorp nil) - (setf (find-class 'idx-five-del) nil)) + (when (class-indexedp-by-name 'idx-five-del) + (disable-class-indexing 'idx-five-del :errorp nil)) + (setf (find-class 'idx-five-del) nil) (defclass idx-five-del () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))

1 0

[elephant-cvs] CVS elephant
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv17545 Modified Files: TODO Log Message: A few details to go green on sbcl and acl on mac32 --- /project/elephant/cvsroot/elephant/TODO 2007/03/03 17:24:55 1.66 +++ /project/elephant/cvsroot/elephant/TODO 2007/03/08 21:29:53 1.67 @@ -20,7 +20,6 @@ - Migration: Improve scaling properties of migration so all objects do not need to be resident in memory? - Migration: Validate that graph structures with loop are copied properly - Migration: Improve printing and informative messages -- Fix class index slot option (and validate test) Lisp Support: - Validate Lispworks on PC @@ -69,6 +68,7 @@ x Minor Bugs: +x Fix class index slot option test x Enable with-transactions to properly process forms returning multiple values (Ian) x Fixed typos in SQL backend (Ian/Robert/Henrik) x Fixed build bug for linux (Henrik)

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv17545/src/elephant Modified Files: classes.lisp classindex.lisp metaclasses.lisp Log Message: A few details to go green on sbcl and acl on mac32 --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/08 19:24:08 1.20 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/08 21:29:53 1.21 @@ -49,7 +49,6 @@ (defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index) "Support the :index class option" - (format t "ecuc nil index = ~A~%" index) (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args)))) (when (and index (subtypep (type-of result) 'persistent-metaclass)) (update-indexed-record result nil :class-indexed t)) @@ -57,7 +56,6 @@ (defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index) "Support the :index class option on redefinition" - (format t "ecuc class index = ~A~%" index) (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args)))) (when index (update-indexed-record result nil :class-indexed t)) @@ -83,6 +81,7 @@ (setf (%persistent-slots instance) (cons (persistent-slot-names instance) nil))) (update-indexed-record instance (indexed-slot-names-from-defs instance)))) + (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys) (declare (ignore initargs)) --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/26 19:12:18 1.26 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/03/08 21:29:53 1.27 @@ -71,7 +71,8 @@ (find-class-index (find-class class-name) :sc sc :errorp errorp)) (defmethod class-indexedp-by-name ((class-name symbol) &key (sc *store-controller*)) - (get-value class-name (controller-class-root sc))) + (let ((class (find-class class-name nil))) + (when class (indexed class)))) (defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*) (errorp t)) (ensure-finalized class) --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/02/26 19:12:18 1.9 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/03/08 21:29:53 1.10 @@ -132,7 +132,7 @@ (indexed-record class) nil))) (setf (%indexed-slots class) - (cons (make-new-indexed-record new-slot-list oldrec class-indexed) + (cons (make-new-indexed-record new-slot-list oldrec (or new-slot-list class-indexed)) (if oldrec oldrec nil))))) (defmethod make-new-indexed-record (new-slot-list oldrec class-indexed)

1 0

[elephant-cvs] CVS elephant/src/query
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant/src/query In directory clnet:/tmp/cvs-serv17545/src/query Modified Files: syntax.lisp Log Message: A few details to go green on sbcl and acl on mac32 --- /project/elephant/cvsroot/elephant/src/query/syntax.lisp 2007/03/06 04:15:27 1.1 +++ /project/elephant/cvsroot/elephant/src/query/syntax.lisp 2007/03/08 21:29:53 1.2 @@ -72,13 +72,18 @@ ;; Dictionary (defun make-relation-dictionary () - (cons nil nil)) + (cons nil 0)) (defun add-set (name class stmt dictionary &optional annotations) (push (list name class stmt annotations) (car dictionary))) +(defun add-anonymous-set (class dict) + (let ((name (format nil "?class~A" (incf (cdr dict))))) + (add-set name class nil dict) + name)) + (defun lookup-set (name dict) - (awhen (assoc name (car dict)) + (awhen (assoc name (car dict) :test #'equal) it)) (defun set-name (setrec) @@ -94,6 +99,7 @@ (fourth setrec)) + ;; Constraints (defun parse-constraints (exprs dictionary) @@ -212,18 +218,68 @@ ,(reference-slot-or-value rec2)) ,(setname)))) -(defun make-join-statement (op rec1 rec2) +(defun make-join-statement (op rec1 rec2 dictionary) (cond ((and (simple-record-p rec1) (simple-record-p rec2)) - ;; An explicit join (assuming op is '=') `(theta-join ,op ,(reference-slot rec1) ,(reference-setname rec1) ,(reference-slot rec2) ,(reference-setname rec2))) ((and (nested-record-p rec1) (value-record-p rec2)) - `(theta-join ,op - ) + (make-nested-join op rec1 rec2)) ((and (value-record-p rec1) (nested-record-p rec1)) - ) + (make-nested-join op rec2 rec1 :reverse t)) + (t (error "Cannot construct complex join statement with ~A and ~A" rec1 rec2)))) +(defun make-nested-join (op rec-nest rec-value dict &key reverse) + (let* ((slot (reference-slot rec-nest)) + (sc-list (assign-join-types nil (reference-form rec-nest))) + (select `(select (,op ,@(when reverse + (list value slot) + (list slot value)) + ,(second (first sc-list)))))) + (nest-joins (rest sc-list) select))) + +(defun nest-joins (sc-list inner-stmt) + "Wraps a cascade of joins with anonymous classes" + (if (null sc-list) + inner-stmt + (let ((slot-class (first sc-list))) + (nest-joins (cdr sc-list) + `(join ,(first slot-class) ,(second slot-class) oid ,inner-stmt))))) + +(defun assign-join-types (accessor nested-form dict) + (if (simple-reference-form-p nested-form dict) + (list nested-form) + (let* ((list (assign-join-types (first nested-form) (second nested-form) dict)) + (type-form (first list))) + (cons (list accessor + (get-set-type (list (first type-form) (get-set-type (second type-form) dict)) dict)) + list)))) + +(defun get-set-type (form dict) + (let ((setrec (lookup-set form dict))) + (if setrec (set-type setrec) + (ifret (infer-type (first form) (second form)) nil)))) + + + +(defun infer-type (slot class) + "Determine the type " + + ((nil namerec) + (name person) + (manager department) + (department emp)) + + + +(= (name (manager (department emp))) "George") +(department emp) = foo +(manager foo) = foo1 +(name foo1) + +(join department emp oid + (project (oid) (join manager ?class1 oid + (project oid (select (= name "George") ?class2))))) (defun reference-slot-or-value (rec) (cond ((value-record-p rec)

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv24009 Modified Files: testindexing.lisp Log Message: Fix for premature checkin --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/08 19:24:45 1.33 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/08 19:50:20 1.34 @@ -115,9 +115,9 @@ (make-instance 'idx-cslot) - (values (if (class-indexedp-by-name 'idx-cslot) t nil)) + (values (if (class-indexedp-by-name 'idx-cslot) t nil))) t) - + ;; test inherited slots (deftest indexing-inherit

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv18112 Modified Files: testindexing.lisp Log Message: Fix for clas indexing test --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/03 17:25:01 1.32 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/08 19:24:45 1.33 @@ -110,9 +110,12 @@ (defclass idx-cslot () ((slot1 :initarg :slot1 :initform 0 :accessor slot1)) - (:metaclass persistent-metaclass :index t)) + (:metaclass persistent-metaclass) + (:index t)) - (values (class-indexedp-by-name 'idx-cslot))) + (make-instance 'idx-cslot) + + (values (if (class-indexedp-by-name 'idx-cslot) t nil)) t)

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 08 Mar '07

08 Mar '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv18074 Modified Files: classes.lisp Log Message: Fix for class indexing test --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/03 17:24:59 1.19 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/08 19:24:08 1.20 @@ -49,6 +49,7 @@ (defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index) "Support the :index class option" + (format t "ecuc nil index = ~A~%" index) (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args)))) (when (and index (subtypep (type-of result) 'persistent-metaclass)) (update-indexed-record result nil :class-indexed t)) @@ -56,6 +57,7 @@ (defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index) "Support the :index class option on redefinition" + (format t "ecuc class index = ~A~%" index) (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args)))) (when index (update-indexed-record result nil :class-indexed t))

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 07 Mar '07

07 Mar '07

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv30477 Modified Files: libmemutil.c Log Message: Fixes for type and fname conflicts --- /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2007/02/01 04:03:27 1.3 +++ /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2007/03/07 22:01:01 1.4 @@ -82,22 +82,22 @@ -------------------------------------------------------------------------------- */ -#define reader_and_writer( DATATYPE ) \ -DATATYPE read_##DATATYPE (char *buf, int offset) { \ +#define reader_and_writer( FNAME, DATATYPE ) \ +DATATYPE read_##FNAME (char *buf, int offset) { \ DATATYPE i; \ memcpy(&i, buf+offset, sizeof( DATATYPE )); \ return i; \ } \ -void write_##DATATYPE (char *buf, DATATYPE num, int offset) { \ +void write_##FNAME (char *buf, DATATYPE num, int offset) { \ memcpy(buf+offset, &num, sizeof( DATATYPE )); \ } -reader_and_writer(int32_t) -reader_and_writer(uint32_t) -reader_and_writer(int64_t) -reader_and_writer(uint64_t) -reader_and_writer(float) -reader_and_writer(double) +reader_and_writer(int32,int32_t) +reader_and_writer(uint32,uint32_t) +reader_and_writer(int64,int64_t) +reader_and_writer(uint64,uint64_t) +reader_and_writer(float,float) +reader_and_writer(double,double) char *offset_charp(char *p, int offset) { return p + offset;

1 0

← Newer
1
...
16
17
18
19
20
21
22
...
86
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs