├── .gitattributes ├── .gitignore ├── LICENSE ├── README.md ├── dev-resources └── log4j2-test.xml ├── doc └── intro.md ├── project.clj ├── src └── aatree │ ├── AAMap.clj │ ├── AASet.clj │ ├── AAVector.clj │ ├── CountedSequence.clj │ ├── calf.clj │ ├── closer_trait.clj │ ├── core.clj │ ├── db_agent_trait.clj │ ├── db_chan_trait.clj │ ├── db_file_trait.clj │ ├── lazy_nodes.clj │ ├── lru_db_cache_trait.clj │ ├── nodes.clj │ ├── null_db_cache_trait.clj │ ├── unique_timestamp.clj │ ├── virtual_nodes.clj │ └── yearling.clj └── test └── aatree ├── adler32_example.clj ├── basic_sorted_map_examples.clj ├── basic_sorted_set_examples.clj ├── basic_vector_examples.clj ├── calf_test.clj ├── closer_trait_test.clj ├── core_test.clj ├── cs256_example.clj ├── db_chan_test.clj ├── file_example.clj ├── lazy_map_benchmark.clj ├── lazy_sorted_map_examples.clj ├── lazy_sorted_set_examples.clj ├── lazy_vector_benchmark.clj ├── lazy_vector_examples.clj ├── log4j_test.clj ├── nodes_test.clj ├── record_play.clj ├── record_play0.clj ├── standard_sorted_map_examples.clj ├── standard_sorted_set_examples.clj ├── standard_vector_examples.clj ├── transcribe_examples.clj ├── transparent_transcription_test.clj ├── unique_timestamp_test.clj ├── virtual_benchmark.clj └── yearling_test.clj /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | /.idea 13 | *.iml 14 | *.lazy 15 | *.calf 16 | *.yearling 17 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # aatree 2 | 3 | A Clojure library for AA Trees. 4 | 5 | [AA Trees](https://en.wikipedia.org/wiki/AA_tree) 6 | are simpler than red-black trees, 7 | which makes them easier to modify and extend. 8 | But the performance is about the same. 9 | 10 | In addition to implementing complete replacements for vector, sorted-set 11 | and sorted-map, an extension is 12 | provided for lazy deserialization/reserialization. 13 | This can be used to minimize the time to deserialize, update and reserialize 14 | a large block of data. Because only a small portion of a data block 15 | needs to be processed, processing is ridiculously fast when compared to 16 | the processing time needed if the entire data block is deserialized / reserialized, 17 | as is typical of applications requiring significant durable data. 18 | 19 | Another extension is provided to support virtual data structures. 20 | Structures no longer need to fit in memory, as only the parts of interest need to be 21 | loaded. 22 | 23 | Validation has been done using 24 | [collection-check](https://github.com/ztellman/collection-check). 25 | Compiled AOT with Clojure 1.7.0. Reflection has been avoided through the 26 | use of warn-on-reflection. 27 | 28 | ## Releases 29 | 30 | * [GitHub](https://github.com/laforge49/aatree/releases) 31 | * [![Clojars Project](http://clojars.org/aatree/latest-version.svg)](http://clojars.org/aatree) 32 | 33 | ## Resources 34 | 35 | * [clojure aatree](https://clojurians.slack.com/messages/aatree/) (slack) 36 | * [![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/laforge49/aatree?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge) 37 | * [google group](https://groups.google.com/forum/?hl=en#!forum/agilewikidevelopers) 38 | * [Blog](https://github.com/laforge49/aatree/wiki/Blog) 39 | * [API](https://github.com/laforge49/aatree/wiki/API) 40 | * [Benchmarks](https://github.com/laforge49/aatree/wiki/Benchmarks) 41 | * [Log4J 2](https://github.com/laforge49/aatree/wiki/Log4J-2) 42 | 43 | ### Durable Applications--File Load and Save 44 | 45 | It is not often that you need lazy deserialization when doing a file load. 46 | Rather, we are using file load and save here to illustrate how to use the lazy 47 | structures of aatree. 48 | 49 | 1. [File Load and Save](https://github.com/laforge49/aatree/wiki/File-Load-and-Save) 50 | 1. [Using Adler32](https://github.com/laforge49/aatree/wiki/Using-Adler32) 51 | 1. [A 256-bit Checksum](https://github.com/laforge49/aatree/wiki/A-256-Bit-Checksum) 52 | 53 | ### Write Me a Database 54 | 55 | It is easy enough to code up a small database, like 56 | [Calf](https://github.com/laforge49/aatree/wiki/Calf), 57 | using lazy aatree structures. 58 | The catch is that the contents of the database must fit in memory. 59 | 60 | ### Virtual Data Structures 61 | 62 | The [Yearling](https://github.com/laforge49/aatree/wiki/Yearling) database 63 | supports virtual data structures, which allows for structures 64 | that are larger than will fit in memory. 65 | [Disk Space Management](https://github.com/laforge49/aatree/wiki/Disk-Space-Management) 66 | is also part of Yearling. 67 | 68 | ### Robustness 69 | 70 | There is still a ways to go before we have a production-ready database. 71 | The biggest failing is that there is no recovery from a failed transaction except to 72 | restart the database. That's just not good enough. 73 | -------------------------------------------------------------------------------- /dev-resources/log4j2-test.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to aatree 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) 4 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject aatree "0.6.2-SNAPSHOT" 2 | :description "A Clojure library for AA Trees" 3 | :url "https://github.com/laforge49/aatree" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.7.0"] 7 | [org.clojure/core.async "0.2.374"] 8 | [org.clojure/core.cache "0.6.4"] 9 | [medley "0.7.0"] 10 | [org.clojure/tools.logging "0.3.1"] 11 | [org.apache.logging.log4j/log4j-core "2.4.1"] 12 | [org.apache.logging.log4j/log4j-slf4j-impl "2.4.1"]] 13 | :aot [aatree.CountedSequence aatree.nodes aatree.AAMap aatree.AAVector aatree.AASet] 14 | :plugins [[lein-cljfmt "0.3.0"]] 15 | :profiles {:dev {:dependencies [[collection-check "0.1.6"]]}}) 16 | -------------------------------------------------------------------------------- /src/aatree/AAMap.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.AAMap 2 | (:gen-class 3 | :main false 4 | :extends clojure.lang.APersistentMap 5 | :implements [clojure.lang.IObj 6 | clojure.lang.Reversible 7 | clojure.lang.Sorted 8 | clojure.lang.Counted 9 | clojure.lang.Indexed 10 | aatree.nodes.INoded] 11 | :constructors {[aatree.nodes.INode clojure.lang.IPersistentMap] 12 | [] 13 | [aatree.nodes.INode clojure.lang.IPersistentMap clojure.lang.IPersistentMap] 14 | []} 15 | :init init 16 | :state state) 17 | (:require [aatree.nodes :refer :all]) 18 | (:import (aatree AAMap) 19 | (clojure.lang MapEntry RT IPersistentMap) 20 | (aatree.nodes INode))) 21 | 22 | (set! *warn-on-reflection* true) 23 | 24 | (defn -getState [^AAMap this] 25 | (.-state this)) 26 | 27 | (defn -init 28 | ([node opts] 29 | [[] (->noded-state node opts nil)]) 30 | ([node opts meta] 31 | [[] (->noded-state node opts meta)])) 32 | 33 | (defn -meta [^AAMap this] (get-meta this)) 34 | 35 | (defn -withMeta [^AAMap this meta] (new AAMap (get-inode this) (get-opts this) meta)) 36 | 37 | (defn -entryAt [^AAMap this key] (map-get-t2 (get-inode this) key (get-opts this))) 38 | 39 | (defn -containsKey [this key] (boolean (-entryAt this key))) 40 | 41 | (defn -valAt 42 | ([this key default] 43 | (let [^MapEntry e (-entryAt this key)] 44 | (if (nil? e) 45 | default 46 | (.getValue e)))) 47 | ([this key] 48 | (-valAt this key nil))) 49 | 50 | (defn -assoc [^AAMap this key val] 51 | (let [n0 (get-inode this) 52 | val (transcriber val (get-opts this)) 53 | n1 (map-insert n0 (new MapEntry key val) (get-opts this))] 54 | (if (identical? n0 n1) 55 | this 56 | (new AAMap n1 (get-opts this) (get-meta this))))) 57 | 58 | (defn -assocEx [^AAMap this key val] 59 | (let [n0 (get-inode this)] 60 | (if (-containsKey this key) 61 | this 62 | (new AAMap 63 | (map-insert n0 (new MapEntry key (transcriber val (get-opts this))) (get-opts this)) 64 | (get-opts this) 65 | (get-meta this))))) 66 | 67 | (defn -without [^AAMap this key] 68 | (let [n0 (get-inode this) 69 | n1 (map-del n0 key (get-opts this))] 70 | (if (identical? n0 n1) 71 | this 72 | (new AAMap n1 (get-opts this) (get-meta this))))) 73 | 74 | (defn -rseq [^AAMap this] 75 | (new-counted-reverse-seq (get-inode this) (get-opts this))) 76 | 77 | (defn -seq 78 | ([^AAMap this] 79 | (new-counted-seq (get-inode this) (get-opts this))) 80 | ([this ascending] 81 | (if ascending 82 | (-seq this) 83 | (-rseq this)))) 84 | 85 | (defn -seqFrom [^AAMap this key ascending] 86 | (if ascending 87 | (new-map-entry-seq (get-inode this) key (get-opts this)) 88 | (new-map-entry-reverse-seq (get-inode this) key (get-opts this)))) 89 | 90 | (defn -empty [^AAMap this] 91 | (new AAMap (empty-node (get-inode this) (get-opts this)) 92 | (get-opts this) 93 | (get-meta this))) 94 | 95 | (defn -count [this] 96 | (.getCnt (get-inode this) (get-opts this))) 97 | 98 | (defn -entryKey [this ^MapEntry entry] 99 | (.getKey entry)) 100 | 101 | (defn -iterator [^AAMap this] 102 | (new-counted-iterator (get-inode this) (get-opts this))) 103 | 104 | (defn -nth 105 | ([^AAMap this i] 106 | (nth-t2 (get-inode this) i (get-opts this))) 107 | ([this i notFound] 108 | (if (and (>= i 0) (< i (-count this))) 109 | (-nth this i) 110 | notFound))) 111 | -------------------------------------------------------------------------------- /src/aatree/AASet.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.AASet 2 | (:gen-class 3 | :main false 4 | :extends clojure.lang.APersistentSet 5 | :implements [clojure.lang.IObj 6 | clojure.lang.Reversible 7 | clojure.lang.Sorted 8 | clojure.lang.Counted 9 | clojure.lang.Indexed 10 | aatree.nodes.INoded] 11 | :constructors {[aatree.AAMap] 12 | [clojure.lang.IPersistentMap] 13 | [aatree.AAMap clojure.lang.IPersistentMap] 14 | [clojure.lang.IPersistentMap]} 15 | :init init 16 | :state impl) 17 | (:require [aatree.nodes :refer :all]) 18 | (:import (aatree AAMap AASet) 19 | (clojure.lang MapEntry RT IPersistentMap ISeq) 20 | (aatree.nodes INode))) 21 | 22 | (set! *warn-on-reflection* true) 23 | 24 | (defn -getState [^AASet this] 25 | (let [^AAMap mpl (.-impl this)] 26 | (.-state mpl))) 27 | 28 | (defn -init 29 | ([aamap] 30 | [[aamap] aamap]) 31 | ([aamap meta] 32 | (let [mpl (with-meta aamap meta)] 33 | [[mpl] mpl]))) 34 | 35 | (defn -meta [this] (get-meta this)) 36 | 37 | (defn -withMeta [^AASet this meta] (new AASet (.-impl this) meta)) 38 | 39 | (defn -disjoin [^AASet this key] 40 | (if (contains? this key) 41 | (new AASet (dissoc (.-impl this) key)) 42 | this)) 43 | 44 | (defn -cons [^AASet this key] 45 | (if (contains? this key) 46 | this 47 | (new AASet (assoc (.-impl this) key key)))) 48 | 49 | (defn -empty [^AASet this] 50 | (new AASet (empty (.-impl this)))) 51 | 52 | (defn -rseq [^AASet this] 53 | (let [^AAMap mpl (.-impl this) 54 | ^ISeq rs (.rseq mpl)] 55 | (clojure.lang.APersistentMap$KeySeq/create rs))) 56 | 57 | (defn -comparator [^AASet this] 58 | (let [^AAMap mpl (.-impl this)] 59 | (.comparator mpl))) 60 | 61 | (defn -entryKey [entry] 62 | entry) 63 | 64 | (defn -seq 65 | ([^AASet this] 66 | (-seq this true)) 67 | ([^AASet this ascending] 68 | (let [^AAMap mpl (.-impl this)] 69 | (RT/keys (.seq mpl ascending))))) 70 | 71 | (defn -seqFrom [^AASet this key ascending] 72 | (let [^AAMap mpl (.-impl this)] 73 | (RT/keys (.seqFrom mpl key ascending)))) 74 | 75 | (defn -count [^AASet this] 76 | (let [^AAMap mpl (.-impl this)] 77 | (.count mpl))) 78 | 79 | (defn -nth 80 | ([^AASet this var1] 81 | (let [^AAMap mpl (.-impl this) 82 | ^MapEntry e (.nth mpl var1)] 83 | (.getKey e))) 84 | ([^AASet this var1 var2] 85 | (let [^AAMap mpl (.-impl this) 86 | n (.nth mpl var1 var2)] 87 | (if (identical? var2 n) 88 | n 89 | (key n))))) 90 | -------------------------------------------------------------------------------- /src/aatree/AAVector.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.AAVector 2 | (:gen-class 3 | :main false 4 | :extends clojure.lang.APersistentVector 5 | :implements [clojure.lang.IObj 6 | aatree.nodes.FlexVector 7 | aatree.nodes.INoded] 8 | :constructors {[aatree.nodes.INode clojure.lang.IPersistentMap] 9 | [] 10 | [aatree.nodes.INode clojure.lang.IPersistentMap clojure.lang.IPersistentMap] 11 | []} 12 | :init init 13 | :state state) 14 | (:require [aatree.nodes :refer :all]) 15 | (:import (aatree AAVector) 16 | (aatree.nodes INode) 17 | (clojure.lang IPersistentMap))) 18 | 19 | (set! *warn-on-reflection* true) 20 | 21 | (defn -getState [^AAVector this] 22 | (.-state this)) 23 | 24 | (defn -init 25 | ([node opts] 26 | [[] (->noded-state node opts nil)]) 27 | ([node opts meta] 28 | [[] (->noded-state node opts meta)])) 29 | 30 | (defn -meta [^AAVector this] (get-meta this)) 31 | 32 | (defn -withMeta [^AAVector this meta] (new AAVector (get-inode this) (get-opts this) meta)) 33 | 34 | (defn -count [this] 35 | (.getCnt (get-inode this) (get-opts this))) 36 | 37 | (defn -nth 38 | ([^AAVector this i] 39 | (nth-t2 (get-inode this) i (get-opts this))) 40 | ([this i notFound] 41 | (if (and (>= i 0) (< i (-count this))) 42 | (-nth this i) 43 | notFound))) 44 | 45 | (defn -cons [^AAVector this val] 46 | (let [n0 (get-inode this) 47 | n1 (vector-add n0 (transcriber val (get-opts this)) (-count this) (get-opts this))] 48 | (new AAVector n1 (get-opts this) (get-meta this)))) 49 | 50 | (defn -addNode [^AAVector this i val] 51 | (let [c (-count this)] 52 | (cond 53 | (= i c) 54 | (-cons this (transcriber val (get-opts this))) 55 | (and (>= i 0) (< i c)) 56 | (let [n0 (get-inode this) 57 | n1 (vector-add n0 (transcriber val (get-opts this)) i (get-opts this))] 58 | (new AAVector n1 (get-opts this) (get-meta this))) 59 | :else 60 | (throw (IndexOutOfBoundsException.))))) 61 | 62 | (defn -assocN [^AAVector this i val] 63 | (let [c (-count this)] 64 | (cond 65 | (= i c) 66 | (-cons this (transcriber val (get-opts this))) 67 | (and (>= i 0) (< i c)) 68 | (let [n0 (get-inode this) 69 | n1 (vector-set n0 (transcriber val (get-opts this)) i (get-opts this))] 70 | (new AAVector n1 (get-opts this) (get-meta this))) 71 | :else 72 | (throw (IndexOutOfBoundsException.))))) 73 | 74 | (defn -empty [^AAVector this] 75 | (new AAVector 76 | (empty-node (get-inode this) (get-opts this)) 77 | (get-opts this) 78 | (get-meta this))) 79 | 80 | (defn -iterator [^AAVector this] 81 | (new-counted-iterator (get-inode this) (get-opts this))) 82 | 83 | (defn -seq 84 | [^AAVector this] 85 | (new-counted-seq (get-inode this) (get-opts this))) 86 | 87 | (defn -pop [^AAVector this] 88 | (if (empty? this) 89 | this 90 | (let [n0 (get-inode this) 91 | n1 (deln n0 (- (-count this) 1) (get-opts this))] 92 | (new AAVector n1 (get-opts this) (get-meta this))))) 93 | 94 | (defn -dropNode [^AAVector this i] 95 | (if (or (< i 0) (>= i (-count this))) 96 | this 97 | (new AAVector 98 | (deln (get-inode this) i (get-opts this)) 99 | (get-opts this) 100 | (get-meta this)))) 101 | -------------------------------------------------------------------------------- /src/aatree/CountedSequence.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.CountedSequence 2 | (:gen-class 3 | :main false 4 | :extends clojure.lang.ASeq 5 | :implements [clojure.lang.Counted] 6 | :constructors {[java.util.Iterator Long clojure.lang.IFn] 7 | [] 8 | [clojure.lang.IPersistentMap Object] 9 | [clojure.lang.IPersistentMap]} 10 | :init init 11 | :state state 12 | :methods [^:static [create [java.util.Iterator Long clojure.lang.IFn] Object]]) 13 | (:import (java.util Iterator) 14 | (clojure.lang Counted) 15 | (aatree CountedSequence))) 16 | 17 | (definterface XIterator 18 | (^Long index []) 19 | (bumpIndex [index]) 20 | (count [index]) 21 | (fetch [index])) 22 | 23 | (set! *warn-on-reflection* true) 24 | 25 | (defn -create [^XIterator iter initialIndex styp] 26 | (if (< 0 (.count iter initialIndex)) 27 | (new aatree.CountedSequence iter initialIndex styp) 28 | nil)) 29 | 30 | (defrecord seq-state [^XIterator iter ndx styp rst]) 31 | 32 | (defn iter ^XIterator [seq-state] (:iter seq-state)) 33 | 34 | (defn -init 35 | ([^Iterator iter initialIndex styp] 36 | (let [^Counted citer iter 37 | s (->seq-state iter initialIndex styp (atom nil))] 38 | (reset! (:rst s) s) 39 | [[] s])) 40 | ([meta s] 41 | [[meta] s])) 42 | 43 | (defn -withMeta [^CountedSequence this meta] (new aatree.CountedSequence meta (.-state this))) 44 | 45 | (defn -first [^CountedSequence this] 46 | (let [s (.-state this)] 47 | (.fetch (iter s) (:ndx s)))) 48 | 49 | (defn -next [^CountedSequence this] 50 | (let [s (.-state this) 51 | ^XIterator it (iter s) 52 | r (:rst s)] 53 | (when (= s @r) 54 | (-first this) 55 | (swap! r #(if (= s %) (-create it (.bumpIndex it (:ndx s)) (:styp s))))) 56 | @(:rst s))) 57 | 58 | (defn -count [^CountedSequence this] 59 | (let [s (.-state this)] 60 | (.count (iter s) (:ndx s)))) 61 | -------------------------------------------------------------------------------- /src/aatree/calf.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.calf 2 | (:require [aatree.core :refer :all] 3 | [aatree.nodes :refer :all] 4 | [aatree.db-file-trait :refer :all] 5 | [aatree.db-chan-trait :refer :all]) 6 | (:import (java.io File) 7 | (java.nio ByteBuffer))) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | (defn- calf-updater [this app-updater] 12 | (app-updater this) 13 | (let [block-size (:db-block-size this) 14 | position (* block-size (mod (get-transaction-count this) 2)) 15 | _ (swap! 16 | (:transaction-count-atom this) 17 | (fn [old] (+ old 1))) 18 | uber-map (update-get this) 19 | map-size (byte-length uber-map) 20 | buffer-size (+ 4 4 8 map-size 32) 21 | ^ByteBuffer bb (ByteBuffer/allocate buffer-size)] 22 | (if (< block-size buffer-size) 23 | (throw (Exception. "block-size exceeded on write"))) 24 | (.putInt bb block-size) 25 | (.putInt bb map-size) 26 | (.putLong bb (get-transaction-count this)) 27 | (put-aa bb uber-map) 28 | (put-cs256 bb (compute-cs256 (.flip (.duplicate bb)))) 29 | (.flip bb) 30 | (db-file-write-root this bb (long position)))) 31 | 32 | (defn calf-null-updater [this]) 33 | 34 | (defn- calf-new [this] 35 | (let [this (assoc this :transaction-count-atom (atom 0)) 36 | uber-map (new-sorted-map this) 37 | db-update-vstate (:db-update-vstate this) 38 | _ (vreset! db-update-vstate uber-map) 39 | _ (calf-updater this calf-null-updater) 40 | _ (calf-updater this calf-null-updater) 41 | uber-map @db-update-vstate] 42 | (vreset! db-update-vstate nil) 43 | [this uber-map])) 44 | 45 | (defn- calf-read [this position] 46 | (let [block-size (:db-block-size this) 47 | ^ByteBuffer bb (ByteBuffer/allocate block-size) 48 | _ (.limit bb (+ 4 4 8)) 49 | _ (db-file-read this bb (long position)) 50 | _ (.flip bb)] 51 | (if (not= block-size (.getInt bb)) 52 | nil 53 | (let [map-size (.getInt bb) 54 | _ (if (< block-size (+ 4 4 8 map-size 32)) 55 | (throw (Exception. "block-size exceeded on read"))) 56 | transaction-count (.getLong bb) 57 | input-size (+ (.limit bb) map-size 32) 58 | _ (.limit bb input-size) 59 | _ (db-file-read this bb (long (+ position 4 4 8))) 60 | _ (.flip bb) 61 | csp (- input-size 32) 62 | _ (.limit bb csp) 63 | cs (compute-cs256 bb) 64 | _ (.limit bb input-size) 65 | ocs (get-cs256 bb) 66 | _ (.position bb (+ 4 4 8)) 67 | _ (.limit bb csp) 68 | uber-map (load-sorted-map bb this)] 69 | (if (not= cs ocs) 70 | nil 71 | {:transaction-count transaction-count :uber-map uber-map}))))) 72 | 73 | (defn- choose [this state0 state1] 74 | (let [state (if state0 75 | (if state1 76 | (if (> (:transaction-count state0) (:transaction-count state1)) 77 | state0 78 | state1) 79 | state0) 80 | (if state1 81 | state1 82 | (throw (Exception. "corrupted database")))) 83 | this (assoc this :transaction-count-atom (atom (:transaction-count state)))] 84 | [this (:uber-map state)])) 85 | 86 | (defn- calf-old [this] 87 | (let [block-size (:db-block-size this) 88 | state0 (calf-read this 0) 89 | state1 (calf-read this block-size)] 90 | (choose this state0 state1))) 91 | 92 | (defn calf-open 93 | ([file block-size] (calf-open {} file block-size)) 94 | ([this ^File file block-size] 95 | (let [this (-> this 96 | (db-file-open file) 97 | (assoc :db-block-size block-size) 98 | (default :new-sorted-map lazy-opts) 99 | (default :create-db-chan db-chan) 100 | (assoc :db-updater calf-updater)) 101 | [this uber-map] (choice this db-file-empty? calf-new calf-old)] 102 | (create-db-chan this uber-map)))) 103 | -------------------------------------------------------------------------------- /src/aatree/closer_trait.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.closer-trait 2 | (:require [clojure.tools.logging :as log])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (defn open-component [this name f] 7 | (log/info (str "opening " name)) 8 | (if-let [fsa (:closer-fsa this)] 9 | (do 10 | (swap! fsa 11 | (fn [fs] 12 | (if fs 13 | (conj fs [f name]) 14 | (atom (list [f name]))))) 15 | this) 16 | (assoc this :closer-fsa (atom (list [f name]))))) 17 | 18 | (defn- do-closer [this fs] 19 | (when fs 20 | (let [fv (first fs) 21 | f (nth fv 0) 22 | name (nth fv 1)] 23 | (try 24 | (log/info (str "closing " name)) 25 | (f this) 26 | (catch Exception e 27 | (log/warn e (str "exception on close of " name))))) 28 | (recur this (next fs)))) 29 | 30 | (defn close-components [this] 31 | (if-let [fsa (:closer-fsa this)] 32 | (let [fs @fsa] 33 | (if fs 34 | (if (compare-and-set! fsa fs nil) 35 | (do-closer this fs) 36 | (recur this)))))) 37 | -------------------------------------------------------------------------------- /src/aatree/core.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.core 2 | (:require [aatree.nodes :refer :all] 3 | [aatree.lazy-nodes :refer :all] 4 | [aatree.virtual-nodes :refer :all] 5 | [medley.core :refer :all]) 6 | (:import (aatree AAMap AAVector AASet) 7 | (aatree.nodes FlexVector INoded IFactory) 8 | (clojure.lang RT MapEntry) 9 | (java.io File) 10 | (java.nio ByteBuffer LongBuffer) 11 | (java.nio.file StandardOpenOption OpenOption) 12 | (java.nio.channels FileChannel) 13 | (java.util BitSet))) 14 | 15 | (set! *warn-on-reflection* true) 16 | 17 | (defn default [map key f] 18 | (if (key map) 19 | map 20 | (f map))) 21 | 22 | (defn choice [map cond fx fy] 23 | (if (cond map) 24 | (fx map) 25 | (fy map))) 26 | 27 | (defn required [map key] 28 | (if (key map) 29 | map 30 | (throw (Exception. (str "missing entry: " key))))) 31 | 32 | (defn assoc-default [map key val] 33 | (if (key map) 34 | map 35 | (assoc map key val))) 36 | 37 | (defn addn [^FlexVector vec ndx val] 38 | (.addNode vec ndx val)) 39 | 40 | (defn dropn [vec & args] 41 | (reduce (fn [^FlexVector v i] (.dropNode v i)) vec args)) 42 | 43 | (defn load-vector [buffer opts] 44 | ((:load-vector opts) buffer opts)) 45 | 46 | (defn load-sorted-map [buffer opts] 47 | ((:load-sorted-map opts) buffer opts)) 48 | 49 | (defn load-sorted-set [buffer opts] 50 | ((:load-sorted-set opts) buffer opts)) 51 | 52 | (defn byte-length [noded] 53 | (node-byte-length (get-inode noded) (get-opts noded))) 54 | 55 | (defn put-aa [buffer aa] 56 | (node-write (get-inode aa) buffer (get-opts aa))) 57 | 58 | (defn has-aafactories [opts] (:new-sorted-map opts)) 59 | 60 | (defn new-standard-sorted-map [opts] 61 | (let [c (:comparator opts)] 62 | (if c 63 | (sorted-map-by c) 64 | (sorted-map)))) 65 | 66 | (defn new-standard-vector [opts] []) 67 | 68 | (defn new-standard-sorted-set [opts] 69 | (let [c (:comparator opts)] 70 | (if c 71 | (sorted-set-by c) 72 | (sorted-set)))) 73 | 74 | (defn standard-opts 75 | ([] (standard-opts {})) 76 | ([opts] 77 | (-> opts 78 | (assoc :new-sorted-map new-standard-sorted-map) 79 | (assoc :new-vector new-standard-vector) 80 | (assoc :new-sorted-set new-standard-sorted-set)))) 81 | 82 | (defn new-basic-sorted-map [opts] 83 | (new AAMap emptyNode opts)) 84 | 85 | (defn new-basic-vector [opts] 86 | (new AAVector emptyNode opts)) 87 | 88 | (defn new-basic-sorted-set [opts] 89 | (new AASet (new AAMap emptyNode opts))) 90 | 91 | (defn basic-opts 92 | ([] (basic-opts {})) 93 | ([opts] 94 | (-> opts 95 | (assoc-default :comparator RT/DEFAULT_COMPARATOR) 96 | (assoc :new-sorted-map new-basic-sorted-map) 97 | (assoc :new-vector new-basic-vector) 98 | (assoc :new-sorted-set new-basic-sorted-set)))) 99 | 100 | (defn new-lazy-sorted-map [opts] 101 | (new AAMap emptyLazyNode (map-opts opts))) 102 | 103 | (defn new-lazy-vector [opts] 104 | (new AAVector emptyLazyNode (vector-opts opts))) 105 | 106 | (defn new-lazy-sorted-set [opts] 107 | (new AASet (new AAMap emptyLazyNode (set-opts opts)))) 108 | 109 | (defn lazy-opts 110 | ([] (lazy-opts {})) 111 | ([opts] 112 | (-> opts 113 | (assoc-default :comparator RT/DEFAULT_COMPARATOR) 114 | (assoc-default :factory-registry default-factory-registry) 115 | (assoc :node-read lazy-read) 116 | (assoc :load-vector load-lazy-vector) 117 | (assoc :load-sorted-map load-lazy-sorted-map) 118 | (assoc :load-sorted-set load-lazy-sorted-set) 119 | (assoc :new-sorted-map new-lazy-sorted-map) 120 | (assoc :new-vector new-lazy-vector) 121 | (assoc :new-sorted-set new-lazy-sorted-set)))) 122 | 123 | (defn new-virtual-sorted-map [opts] 124 | (new AAMap emptyVirtualNode (map-opts opts))) 125 | 126 | (defn new-virtual-vector [opts] 127 | (new AAVector emptyVirtualNode (vector-opts opts))) 128 | 129 | (defn new-virtual-sorted-set [opts] 130 | (new AASet (new AAMap emptyVirtualNode (set-opts opts)))) 131 | 132 | (defn virtual-opts 133 | ([] (virtual-opts {})) 134 | ([opts] 135 | (-> opts 136 | (assoc-default :comparator RT/DEFAULT_COMPARATOR) 137 | (assoc-default :factory-registry default-factory-registry) 138 | (assoc :find-dropped-blocks find-dropped-blocks) 139 | (assoc :node-read virtual-read) 140 | (assoc :as-reference virtual-as-reference) 141 | (assoc :load-vector load-virtual-vector) 142 | (assoc :load-sorted-map load-virtual-sorted-map) 143 | (assoc :load-sorted-set load-virtual-sorted-set) 144 | (assoc :new-sorted-map new-virtual-sorted-map) 145 | (assoc :new-vector new-virtual-vector) 146 | (assoc :new-sorted-set new-virtual-sorted-set)))) 147 | 148 | (defn new-sorted-map [opts] 149 | ((:new-sorted-map opts) opts)) 150 | 151 | (defn new-vector [opts] 152 | ((:new-vector opts) opts)) 153 | 154 | (defn new-sorted-set [opts] 155 | ((:new-sorted-set opts) opts)) 156 | 157 | (defn file-save [^ByteBuffer buffer ^File file] 158 | (let [^FileChannel fc (FileChannel/open (.toPath file) 159 | (into-array OpenOption 160 | [StandardOpenOption/CREATE 161 | StandardOpenOption/TRUNCATE_EXISTING 162 | StandardOpenOption/WRITE]))] 163 | (try 164 | (.write fc buffer) 165 | (catch Exception e 166 | (.close fc) 167 | (throw e))) 168 | (.close fc))) 169 | 170 | (defn ^ByteBuffer file-load [^File file] 171 | (let [^FileChannel fc (FileChannel/open (.toPath file) 172 | (into-array OpenOption 173 | [StandardOpenOption/CREATE 174 | StandardOpenOption/READ]))] 175 | (try 176 | (let [size (.size fc) 177 | bb (ByteBuffer/allocate size)] 178 | (.read fc bb) 179 | (.flip bb) 180 | bb) 181 | (finally 182 | (.close fc))))) 183 | 184 | (defn create-db-chan [this initial-state] ((:create-db-chan this) this initial-state)) 185 | 186 | (defn get-transaction-count [this] 187 | @(:transaction-count-atom this)) 188 | 189 | (defn get-last-node-id [this] 190 | @(:last-node-id-atom this)) 191 | 192 | (defn get-time-millis [this] 193 | @(:time-millis-volatile this)) 194 | 195 | (defn ^BitSet get-allocated-bit-set [this] 196 | (:allocated-bit-set this)) 197 | 198 | (defn db-get [this] ((:db-get-state this) this)) 199 | 200 | (defn db-get-in [this keys] (get-in (db-get this) keys)) 201 | 202 | (defn update-get [this] 203 | @(:db-update-vstate this)) 204 | 205 | (defn update-get-in [this ks] 206 | (get-in @(:db-update-vstate this) ks)) 207 | 208 | (defn update-assoc-in! [this ks v] 209 | (let [db-update-vstate (:db-update-vstate this)] 210 | (vreset! db-update-vstate (assoc-in @db-update-vstate ks v)))) 211 | 212 | (defn update-dissoc-in! [this ks] 213 | (let [db-update-vstate (:db-update-vstate this) 214 | new-db-state (dissoc-in @db-update-vstate ks)] 215 | (vreset! db-update-vstate new-db-state))) 216 | 217 | (defn db-send [this app-updater] ((:db-send this) this app-updater)) 218 | 219 | (defn db-update [this app-updater] ((:db-update this) this app-updater)) 220 | 221 | (defn db-block-size [this] (:db-block-size this)) 222 | 223 | (defn check-buffer-size [this ^ByteBuffer byte-buffer] 224 | (let [db-block-size (db-block-size this) 225 | limit (.limit byte-buffer)] 226 | (if (> limit db-block-size) 227 | (throw (Exception. (str "byte buffer is too big:" limit)))))) 228 | 229 | (defn block-read [this block-nbr block-length] 230 | ((:block-read this) this block-nbr block-length)) 231 | 232 | (defn block-write [this block-nbr byte-buffer] 233 | ((:block-write this) this block-nbr byte-buffer)) 234 | 235 | (defn block-clear [this block-nbr] 236 | ((:block-clear this) this block-nbr)) 237 | 238 | (defn db-file-empty? [this] 239 | ((:db-file-empty? this))) 240 | 241 | (defn db-file-force [this] 242 | ((:db-file-force this))) 243 | 244 | (defn db-file-read [this byte-buffer position] 245 | ((:db-file-read this) byte-buffer position)) 246 | 247 | (defn db-file-write [this byte-buffer position] 248 | ((:db-file-write this) byte-buffer position)) 249 | 250 | (defn db-file-write-root [this byte-buffer position] 251 | ((:db-file-write-root this) byte-buffer position)) 252 | 253 | (defn db-allocated [this] ((:db-allocated this) this)) 254 | 255 | (defn db-allocate [this] ((:db-allocate this) this)) 256 | 257 | (defn db-release [this block-nbr] ((:db-release this) this block-nbr)) 258 | 259 | (defn db-process-pending [this age trans] ((:db-process-pending this) this age trans)) 260 | 261 | (defn db-new-node-id [this] ((:db-new-node-id this) this)) 262 | 263 | (register-factory 264 | default-factory-registry 265 | vector-context 266 | (reify IFactory 267 | (factoryId [this] (byte \v)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; v aavector in aavector 268 | (instanceClass [this] aatree.AAVector) 269 | (qualified [this t2 opts] this) 270 | (valueLength [this node opts] 271 | (let [^INoded v (.getT2 node opts)] 272 | (node-byte-length (get-inode v) (get-opts v)))) 273 | (deserialize [this node bb opts] 274 | ((:load-vector opts) bb opts)) 275 | (writeValue [this node buffer opts] 276 | (let [^INoded v (.getT2 node opts)] 277 | (node-write (get-inode v) buffer (get-opts v)))) 278 | (valueNode [this node opts] 279 | (let [^INoded v (.getT2 node opts)] 280 | (get-inode v))))) 281 | 282 | (register-factory 283 | default-factory-registry 284 | vector-context 285 | (reify IFactory 286 | (factoryId [this] (byte \m)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; m aamap in aavector 287 | (instanceClass [this] aatree.AAMap) 288 | (qualified [this t2 opts] this) 289 | (valueLength [this node opts] 290 | (let [^INoded m (.getT2 node opts)] 291 | (node-byte-length (get-inode m) (get-opts m)))) 292 | (deserialize [this node bb opts] 293 | ((:load-sorted-map opts) bb opts)) 294 | (writeValue [this node buffer opts] 295 | (let [^INoded v (.getT2 node opts)] 296 | (node-write (get-inode v) buffer (get-opts v)))) 297 | (valueNode [this node opts] 298 | (let [^INoded v (.getT2 node opts)] 299 | (get-inode v))))) 300 | 301 | (register-factory 302 | default-factory-registry 303 | vector-context 304 | (reify IFactory 305 | (factoryId [this] (byte \s)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; s aaset in aavector 306 | (instanceClass [this] aatree.AASet) 307 | (qualified [this t2 opts] this) 308 | (valueLength [this node opts] 309 | (let [^INoded m (.getT2 node opts)] 310 | (node-byte-length (get-inode m) (get-opts m)))) 311 | (deserialize [this node bb opts] 312 | ((:load-sorted-set opts) bb opts)) 313 | (writeValue [this node buffer opts] 314 | (let [^INoded s (.getT2 node opts)] 315 | (node-write (get-inode s) buffer (get-opts s)))) 316 | (valueNode [this node opts] 317 | (let [^INoded v (.getT2 node opts)] 318 | (get-inode v))))) 319 | 320 | (register-factory 321 | default-factory-registry 322 | map-context 323 | (reify IFactory 324 | (factoryId [this] (byte \V)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; V aavector in aamap 325 | (instanceClass [this] aatree.AAVector) 326 | (qualified [this t2 opts] this) 327 | (sval [this inode opts] 328 | (key-sval this inode opts)) 329 | (valueLength [this node opts] 330 | (let [^MapEntry map-entry (.getT2 node opts) 331 | ^INoded v (.getValue map-entry)] 332 | (+ (default-valueLength this node opts) 333 | (node-byte-length (get-inode v) (get-opts v))))) 334 | (deserialize [this node bb opts] 335 | (let [k (deserialize-sval this node bb opts) 336 | v ((:load-vector opts) bb opts)] 337 | (MapEntry. k v))) 338 | (writeValue [this node buffer opts] 339 | (default-write-value this node buffer opts) 340 | (let [^MapEntry map-entry (.getT2 node opts) 341 | ^INoded v (.getValue map-entry)] 342 | (node-write (get-inode v) buffer (get-opts v)))) 343 | (valueNode [this node opts] 344 | (let [^MapEntry map-entry (.getT2 node opts) 345 | ^INoded v (.getValue map-entry)] 346 | (get-inode v))))) 347 | 348 | (register-factory 349 | default-factory-registry 350 | map-context 351 | (reify IFactory 352 | (factoryId [this] (byte \M)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; M aamap in aamap 353 | (instanceClass [this] aatree.AAMap) 354 | (qualified [this t2 opts] this) 355 | (sval [this inode opts] 356 | (key-sval this inode opts)) 357 | (valueLength [this node opts] 358 | (let [^MapEntry map-entry (.getT2 node opts) 359 | ^INoded m (.getValue map-entry)] 360 | (+ (default-valueLength this node opts) 361 | (node-byte-length (get-inode m) (get-opts m))))) 362 | (deserialize [this node bb opts] 363 | (let [k (deserialize-sval this node bb opts) 364 | v ((:load-sorted-map opts) bb opts)] 365 | (MapEntry. k v))) 366 | (writeValue [this node buffer opts] 367 | (default-write-value this node buffer opts) 368 | (let [^MapEntry map-entry (.getT2 node opts) 369 | ^INoded m (.getValue map-entry)] 370 | (node-write (get-inode m) buffer (get-opts m)))) 371 | (valueNode [this node opts] 372 | (let [^MapEntry map-entry (.getT2 node opts) 373 | ^INoded v (.getValue map-entry)] 374 | (get-inode v))))) 375 | 376 | (register-factory 377 | default-factory-registry 378 | map-context 379 | (reify IFactory 380 | (factoryId [this] (byte \S)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; S aaset in aamap 381 | (instanceClass [this] aatree.AASet) 382 | (qualified [this t2 opts] this) 383 | (sval [this inode opts] 384 | (key-sval this inode opts)) 385 | (valueLength [this node opts] 386 | (let [^MapEntry map-entry (.getT2 node opts) 387 | ^INoded s (.getValue map-entry)] 388 | (+ (default-valueLength this node opts) 389 | (node-byte-length (get-inode s) (get-opts s))))) 390 | (deserialize [this node bb opts] 391 | (let [k (deserialize-sval this node bb opts) 392 | v ((:load-sorted-set opts) bb opts)] 393 | (MapEntry. k v))) 394 | (writeValue [this node buffer opts] 395 | (default-write-value this node buffer opts) 396 | (let [^MapEntry map-entry (.getT2 node opts) 397 | ^INoded s (.getValue map-entry)] 398 | (node-write (get-inode s) buffer (get-opts s)))) 399 | (valueNode [this node opts] 400 | (let [^MapEntry map-entry (.getT2 node opts) 401 | ^INoded v (.getValue map-entry)] 402 | (get-inode v))))) 403 | 404 | (defn transcribe [val opts] (transcriber val opts)) 405 | 406 | (defn aa-opts [aa] (get-opts aa)) 407 | -------------------------------------------------------------------------------- /src/aatree/db_agent_trait.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.db-agent-trait 2 | (:require [aatree.core :refer :all] 3 | [clojure.tools.logging :as log]) 4 | (:import (clojure.lang Agent))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | (defn- db-vstate-set! [db, new-db-update-state] 9 | (vswap! 10 | (:db-update-vstate db) 11 | (fn [db-update-state] 12 | (if db-update-state 13 | (throw (Exception. "db-update-vstate not nil"))) 14 | new-db-update-state))) 15 | 16 | (defn- db-vstate-clear! [db] 17 | (vswap! 18 | (:db-update-vstate db) 19 | (fn [db-update-state] 20 | (if (not db-update-state) 21 | (throw (Exception. "db-update-vstate nil"))) 22 | nil))) 23 | 24 | (defn db-agent [this] 25 | (-> this 26 | (assoc 27 | :db-update-vstate 28 | (volatile! nil)) 29 | (assoc 30 | :create-db-chan 31 | (fn [db initial-state] 32 | (assoc 33 | db 34 | :db-agent 35 | (apply agent initial-state (get db :db-agent-options []))))) 36 | (assoc 37 | :db-get-state 38 | (fn [db] 39 | @(:db-agent db))) 40 | (assoc 41 | :db-send 42 | (fn [db app-updater] 43 | (let [^Agent db-agent (:db-agent db)] 44 | (send-off 45 | db-agent 46 | (fn [db-state] 47 | (try 48 | (db-vstate-set! db db-state) 49 | ((:db-updater db) db app-updater) 50 | (let [db-state @(:db-update-vstate db)] 51 | (db-vstate-clear! db) 52 | db-state) 53 | (catch Throwable t 54 | (log/error t "db update failure") 55 | (throw t)))))))) 56 | (assoc 57 | :db-update 58 | (fn [db app-updater] 59 | (db-send db app-updater) 60 | (let [send-write-timeout (:send-update-timeout db) 61 | db-agent (:db-agent db)] 62 | (if send-write-timeout 63 | (await-for send-write-timeout db-agent) 64 | (await db-agent))))))) -------------------------------------------------------------------------------- /src/aatree/db_chan_trait.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.db-chan-trait 2 | (:require [clojure.core.async :refer [>! !! !! rchan true))) 47 | (catch Throwable t 48 | (log/error t "db update failure") 49 | (close-components this) 50 | )) 51 | (recur))))) 52 | 53 | (defn db-chan [this] 54 | (-> this 55 | (assoc 56 | :db-update-vstate 57 | (volatile! nil)) 58 | (assoc 59 | :create-db-chan 60 | (fn [db initial-state] 61 | (let [db (-> db 62 | (assoc 63 | :db-state-atom 64 | (atom initial-state)) 65 | (assoc 66 | :db-chan 67 | (chan (:db-buf-or-n db))) 68 | (open-component 69 | "db-chan" 70 | (fn [d] (close! (:db-chan d)))))] 71 | (thread (process-chan db)) 72 | db))) 73 | (assoc 74 | :db-get-state 75 | (fn [db] 76 | @(:db-state-atom db))) 77 | (assoc 78 | :db-send 79 | (fn [db app-updater] 80 | (>!! (:db-chan db) [app-updater nil]))) 81 | (assoc 82 | :db-update 83 | (fn [db app-updater] 84 | (let [rchan (chan) 85 | _ (>!! (:db-chan db) [app-updater rchan]) 86 | send-update-timeout (:send-update-timeout db) 87 | rsp (if send-update-timeout 88 | (first (alts!! [rchan (timeout send-update-timeout)])) 89 | ( this 28 | (assoc :db-file-channel file-channel) 29 | (open-component (str "db file " file) (fn [_] (.close file-channel))) 30 | (assoc :db-file-empty? 31 | (fn [] 32 | (= 0 (.size file-channel)))) 33 | (assoc :db-file-read 34 | (fn [byte-buffer position] 35 | (.read file-channel byte-buffer position))) 36 | (assoc :db-file-write 37 | (fn [byte-buffer position] 38 | (.write file-channel byte-buffer position))) 39 | (assoc :db-file-write-root 40 | (fn [byte-buffer position] 41 | (.force file-channel true) 42 | (.write file-channel byte-buffer position) 43 | (.force file-channel true))) 44 | (assoc :db-file-force 45 | (fn [] (.force file-channel true))))))))) 46 | -------------------------------------------------------------------------------- /src/aatree/lazy_nodes.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lazy-nodes 2 | (:require [aatree.nodes :refer :all]) 3 | (:import (java.nio ByteBuffer) 4 | (aatree.nodes Node IFactory WrapperNode) 5 | (clojure.lang RT) 6 | (aatree AAVector AAMap AASet))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (declare ->LazyNode 11 | ^aatree.nodes.INode get-lazy-data 12 | create-lazy-empty-node 13 | lazy-byte-length 14 | lazy-write) 15 | 16 | (deftype LazyNode [data-atom sval-atom blen-atom buffer-atom factory] 17 | 18 | aatree.nodes.INode 19 | 20 | (newNode [this t2 level left right cnt opts] 21 | (let [d (->Node t2 level left right cnt) 22 | f (factory-for-instance t2 opts)] 23 | (->LazyNode (atom d) (atom nil) (atom nil) (atom nil) f))) 24 | 25 | (getT2 [this opts] (.getT2 (get-lazy-data this opts) opts)) 26 | 27 | (^Long getLevel [this opts] (.getLevel (get-lazy-data this opts) opts)) 28 | 29 | (getLeft [this opts] (.getLeft (get-lazy-data this opts) opts)) 30 | 31 | (getRight [this opts] (.getRight (get-lazy-data this opts) opts)) 32 | 33 | (^Long getCnt [this opts] (.getCnt (get-lazy-data this opts) opts)) 34 | 35 | (getNada [this] (create-lazy-empty-node)) 36 | 37 | WrapperNode 38 | 39 | (svalAtom [this] (.-sval-atom this)) 40 | 41 | (blenAtom [this] (.-blen-atom this)) 42 | 43 | (bufferAtom [this] (.-buffer-atom this)) 44 | 45 | (factory [this] (.-factory this)) 46 | 47 | (nodeByteLength [this opts] (lazy-byte-length this opts)) 48 | 49 | (nodeWrite [this buffer opts] (lazy-write this buffer opts))) 50 | 51 | (defn- get-data-atom [^LazyNode this] (.-data-atom this)) 52 | 53 | (defn lazy-byte-length [^LazyNode lazy-node opts] 54 | (if (empty-node? lazy-node) 55 | 1 56 | (let [a (.blenAtom lazy-node) 57 | blen @a] 58 | (if (nil? blen) 59 | (let [^ByteBuffer bb @(.bufferAtom lazy-node) 60 | blen (if bb 61 | (.limit bb) 62 | (+ 1 ;node id 63 | 4 ;byte length - 5 64 | (lazy-byte-length (left-node lazy-node opts) opts) ;left node 65 | 4 ;level 66 | 4 ;cnt 67 | (.valueLength (get-factory lazy-node) lazy-node opts) ;t2 68 | (lazy-byte-length (right-node lazy-node opts) opts)))] ;right node 69 | (compare-and-set! a nil blen))) 70 | @a))) 71 | 72 | (defn lazy-write [^LazyNode lazy-node ^ByteBuffer buffer opts] 73 | (let [^IFactory f (.factory lazy-node) 74 | ^ByteBuffer old-bb (get-buffer lazy-node)] 75 | (if old-bb 76 | (let [new-bb (.duplicate old-bb) 77 | lim (.limit new-bb) 78 | ba (byte-array lim)] 79 | (.get new-bb ba) 80 | (.put buffer ba)) 81 | (let [new-bb (.slice buffer)] 82 | (if (= (byte \n) (.factoryId f)) 83 | (.put buffer (byte (.factoryId f))) 84 | (do 85 | (.put buffer (byte (.factoryId f))) 86 | (.putInt buffer (- (lazy-byte-length lazy-node opts) 5)) 87 | (lazy-write (left-node lazy-node opts) buffer opts) 88 | (.putInt buffer (.getLevel lazy-node opts)) 89 | (.putInt buffer (.getCnt lazy-node opts)) 90 | (.writeValue f lazy-node buffer opts) 91 | (lazy-write (right-node lazy-node opts) buffer opts))) 92 | (.limit new-bb (lazy-byte-length lazy-node opts)) 93 | (compare-and-set! (get-buffer-atom lazy-node) nil new-bb) 94 | (reset! (get-data-atom lazy-node) nil))))) 95 | 96 | (defn lazy-read [^ByteBuffer buffer opts] 97 | (let [^ByteBuffer bb (.slice buffer) 98 | id (.get bb)] 99 | (if (= id (byte \n)) 100 | (do (.get buffer) 101 | (create-lazy-empty-node)) 102 | (let [f (factory-for-id id opts) 103 | bb (.slice buffer) 104 | _ (.get buffer) 105 | lm5 (.getInt buffer) 106 | _ (.position buffer (+ lm5 (.position buffer))) 107 | blen (+ 5 lm5) 108 | _ (.limit bb blen)] 109 | (->LazyNode 110 | (atom nil) 111 | (atom nil) 112 | (atom blen) 113 | (atom bb) 114 | f))))) 115 | 116 | (defn- get-lazy-data [^LazyNode this opts] 117 | (if (empty-node? this) 118 | emptyNode 119 | (let [a (get-data-atom this)] 120 | (when (nil? @a) 121 | (let [bb (.slice (get-buffer this)) 122 | _ (.position bb 5) 123 | left (lazy-read bb opts) 124 | level (long (.getInt bb)) 125 | cnt (long (.getInt bb)) 126 | t2 (.deserialize (get-factory this) this bb opts) 127 | right (lazy-read bb opts)] 128 | (compare-and-set! a nil (Node. t2 level left right cnt)))) 129 | @a))) 130 | 131 | (def ^LazyNode emptyLazyNode 132 | (->LazyNode 133 | (atom emptyNode) 134 | (atom nil) 135 | (atom 1) 136 | (atom nil) 137 | (factory-for-id 138 | (byte \n) 139 | {:factory-registry default-factory-registry}))) 140 | 141 | (defn create-lazy-empty-node 142 | [] emptyLazyNode) 143 | 144 | (defn load-lazy-vector [buffer opts] 145 | (if (:factory-registry opts) 146 | (let [r (vector-opts opts)] 147 | (new AAVector (node-read buffer r) r)) 148 | (let [r (assoc opts :factory-registry default-factory-registry) 149 | r (vector-opts r)] 150 | (new AAVector (node-read buffer r) r)))) 151 | 152 | (defn load-lazy-sorted-map [buffer opts] 153 | (let [r opts 154 | r (if (:comparator r) 155 | r 156 | (assoc r :comparator RT/DEFAULT_COMPARATOR)) 157 | r (if (:factory-registry r) 158 | r 159 | (assoc r :factory-registry default-factory-registry)) 160 | r (map-opts r)] 161 | (new AAMap (node-read buffer r) r))) 162 | 163 | (defn load-lazy-sorted-set [buffer opts] 164 | (let [r opts 165 | r (if (:comparator r) 166 | r 167 | (assoc r :comparator RT/DEFAULT_COMPARATOR)) 168 | r (if (:factory-registry r) 169 | r 170 | (assoc r :factory-registry default-factory-registry)) 171 | r (set-opts r)] 172 | (new AASet 173 | (new AAMap (node-read buffer r) r)))) 174 | -------------------------------------------------------------------------------- /src/aatree/lru_db_cache_trait.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lru-db-cache-trait 2 | (:require [aatree.core :refer :all] 3 | [clojure.core.cache :refer :all]) 4 | (:import (java.nio ByteBuffer))) 5 | 6 | (defn lru-db-cache [this] 7 | (let [this (assoc-default this :threshold 32)] 8 | (-> this 9 | (assoc 10 | :block-cache-atom 11 | (atom (lru-cache-factory {} :threshold (:threshold this)))) 12 | (assoc 13 | :block-read 14 | (fn [db block-nbr ^ByteBuffer block-length] 15 | (let [block-cache-atom (:block-cache-atom db) 16 | ^ByteBuffer byte-buffer (lookup @block-cache-atom block-nbr)] 17 | (if byte-buffer 18 | (do 19 | (if (not= (.limit byte-buffer) block-length) 20 | (throw (Exception. (str "wrong block for block" block-nbr)))) 21 | (swap! 22 | block-cache-atom 23 | hit 24 | block-nbr) 25 | (.asReadOnlyBuffer byte-buffer)) 26 | (do 27 | (if (> block-length (db-block-size db)) 28 | (throw (Exception. (str "block length is too big:" block-length)))) 29 | (let [^ByteBuffer byte-buffer (ByteBuffer/allocate block-length)] 30 | (db-file-read db byte-buffer (* block-nbr (db-block-size db))) 31 | (.flip byte-buffer) 32 | (swap! 33 | block-cache-atom 34 | miss 35 | block-nbr 36 | byte-buffer) 37 | (.asReadOnlyBuffer byte-buffer))))))) 38 | (assoc 39 | :block-write 40 | (fn [db block-nbr ^ByteBuffer byte-buffer] 41 | (check-buffer-size db byte-buffer) 42 | (swap! 43 | (:block-cache-atom db) 44 | assoc 45 | block-nbr 46 | (.asReadOnlyBuffer byte-buffer)) 47 | (db-file-write db byte-buffer (* block-nbr (db-block-size db))))) 48 | (assoc 49 | :block-clear 50 | (fn [db block-nbr] 51 | (swap! 52 | (:block-cache-atom db) 53 | (fn [old] 54 | (evict old block-nbr)))))))) 55 | -------------------------------------------------------------------------------- /src/aatree/nodes.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.nodes 2 | (:import (clojure.lang Counted MapEntry IMapEntry PersistentVector) 3 | (java.util Iterator Comparator BitSet) 4 | (aatree CountedSequence) 5 | (aatree.CountedSequence XIterator) 6 | (java.nio CharBuffer ByteBuffer LongBuffer))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (definterface INode 11 | (newNode [t2 ^Long level left right ^Long cnt opts]) 12 | (getT2 [opts]) 13 | (^Long getLevel [opts]) 14 | (getLeft [opts]) 15 | (getRight [opts]) 16 | (^Long getCnt [opts]) 17 | (getNada [])) 18 | 19 | (deftype noded-state [node opts meta]) 20 | 21 | (definterface INoded 22 | (getState [])) 23 | 24 | (defn ^noded-state get-state [^INoded this] 25 | (.getState this)) 26 | 27 | (defn ^INode get-inode [noded] 28 | (.-node (get-state noded))) 29 | 30 | (defn get-opts [noded] 31 | (.-opts (get-state noded))) 32 | 33 | (defn get-meta [noded] 34 | (.-meta (get-state noded))) 35 | 36 | (defn empty-node? [^INode n] 37 | (or (nil? n) (identical? n (.getNada n)))) 38 | 39 | (defn last-t2 [^INode this opts] 40 | (cond 41 | (empty-node? this) 42 | nil 43 | (empty-node? (.getRight this opts)) 44 | (.getT2 this opts) 45 | :else 46 | (recur (.getRight this opts) opts))) 47 | 48 | (defn empty-node [^INode this opts] 49 | (if (empty-node? this) 50 | this 51 | (.getNada this))) 52 | 53 | (defn ^INode left-node [^INode this opts] 54 | (if (empty-node? (.getLeft this opts)) 55 | (empty-node this opts) 56 | (.getLeft this opts))) 57 | 58 | (defn ^INode right-node [^INode this opts] 59 | (if (empty-node? (.getRight this opts)) 60 | (empty-node this opts) 61 | (.getRight this opts))) 62 | 63 | (defn ^Long node-count [^INode this opts] 64 | (if (empty-node? this) 65 | 0 66 | (.getCnt this opts))) 67 | 68 | (defn revise [^INode this args opts] 69 | (let [m (apply array-map args) 70 | t-2 (get m :t2 (.getT2 this opts)) 71 | ^Long lev (get m :level (.getLevel this opts)) 72 | l (get m :left (left-node this opts)) 73 | r (get m :right (right-node this opts)) 74 | ^Long c (+ 1 (node-count l opts) (node-count r opts))] 75 | (if (and (identical? t-2 (.getT2 this opts)) 76 | (= lev (.getLevel this opts)) 77 | (identical? l (left-node this opts)) 78 | (identical? r (right-node this opts))) 79 | this 80 | (.newNode this t-2 lev l r c opts)))) 81 | 82 | (defn skew 83 | [^INode this opts] 84 | (cond 85 | (empty-node? this) 86 | this 87 | (empty-node? (.getLeft this opts)) 88 | this 89 | (= (.getLevel (left-node this opts) opts) (.getLevel this opts)) 90 | (let [l (.getLeft this opts)] 91 | (revise l [:right (revise this [:left (right-node l opts)] opts)] opts)) 92 | :else 93 | this)) 94 | 95 | (defn split [^INode this opts] 96 | (cond 97 | (empty-node? this) 98 | this 99 | (or (empty-node? (right-node this opts)) 100 | (empty-node? (right-node (right-node this opts) opts))) 101 | this 102 | (= (.getLevel this opts) (.getLevel (right-node (right-node this opts) opts) opts)) 103 | (revise (right-node this opts) 104 | [:level (+ 1 (.getLevel (right-node this opts) opts)) 105 | :left (revise this [:right (.getLeft (right-node this opts) opts)] opts)] 106 | opts) 107 | :else 108 | this)) 109 | 110 | (defn predecessor-t2 [this opts] 111 | (last-t2 (left-node this opts) opts)) 112 | 113 | (defn decrease-level [^INode this opts] 114 | (let [should-be (+ 1 (min (.getLevel (left-node this opts) opts) 115 | (.getLevel (right-node this opts) opts)))] 116 | (if (>= should-be (.getLevel this opts)) 117 | this 118 | (let [rn (right-node this opts) 119 | rn (if (>= should-be (.getLevel (right-node this opts) opts)) 120 | rn 121 | (revise rn [:level should-be] opts))] 122 | (revise this [:right rn :level should-be] opts))))) 123 | 124 | (defn nth-t2 [^INode this i opts] 125 | (if (empty-node? this) 126 | (throw (IndexOutOfBoundsException.)) 127 | (let [l (left-node this opts) 128 | p (.getCnt l opts)] 129 | (cond 130 | (< i p) 131 | (nth-t2 l i opts) 132 | (> i p) 133 | (nth-t2 (right-node this opts) (- i p 1) opts) 134 | :else 135 | (.getT2 this opts))))) 136 | 137 | (defn deln [^INode this i opts] 138 | (if (empty-node? this) 139 | this 140 | (let [l (left-node this opts) 141 | p (.getCnt l opts)] 142 | (if (and (= i p) (= 1 (.getLevel this opts))) 143 | (right-node this opts) 144 | (let [t (cond 145 | (> i p) 146 | (revise this [:right (deln (right-node this opts) (- i p 1) opts)] opts) 147 | (< i p) 148 | (revise this [:left (deln (left-node this opts) i opts)] opts) 149 | :else 150 | (let [pre (predecessor-t2 this opts)] 151 | (revise this [:t2 pre :left (deln (left-node this opts) (- i 1) opts)] opts))) 152 | t (decrease-level t opts) 153 | t (skew t opts) 154 | t (revise t [:right (skew (right-node t opts) opts)] opts) 155 | r (right-node t opts) 156 | t (if (empty-node? r) 157 | t 158 | (revise t [:right (revise r [:right (skew (right-node r opts) opts)] opts)] opts)) 159 | t (split t opts) 160 | t (revise t [:right (split (right-node t opts) opts)] opts)] 161 | t))))) 162 | 163 | (deftype counted-iterator 164 | [node 165 | ^{:volatile-mutable true Long true} ndx 166 | ^Long cnt 167 | opts] 168 | 169 | XIterator 170 | (count [this index] 171 | (- cnt index)) 172 | (index [this] 173 | ndx) 174 | (bumpIndex [this index] 175 | (+ 1 index)) 176 | (fetch [this index] 177 | (nth-t2 node index opts)) 178 | 179 | Counted 180 | (count [this] 181 | (.count this ndx)) 182 | 183 | Iterator 184 | (hasNext [this] 185 | (< ndx cnt)) 186 | (next [this] 187 | (let [i ndx] 188 | (set! ndx (.bumpIndex this i)) 189 | (.fetch this i)))) 190 | 191 | (defn ^counted-iterator new-counted-iterator 192 | ([^INode node opts] 193 | (->counted-iterator node 0 (.getCnt node opts) opts)) 194 | ([^INode node i opts] 195 | (->counted-iterator node i (.getCnt node opts) opts))) 196 | 197 | (defn ^CountedSequence new-counted-seq 198 | ([node opts] 199 | (let [it (new-counted-iterator node opts)] 200 | (CountedSequence/create it (.index it) identity))) 201 | ([node i opts] 202 | (let [it (new-counted-iterator node i opts)] 203 | (CountedSequence/create it (.index it) identity)))) 204 | 205 | (deftype counted-reverse-iterator 206 | [node 207 | ^{:volatile-mutable true Long true} ndx 208 | opts] 209 | 210 | XIterator 211 | (count [this index] 212 | (+ 1 index)) 213 | (index [this] 214 | ndx) 215 | (bumpIndex [this index] 216 | (- index 1)) 217 | (fetch [this index] 218 | (nth-t2 node index opts)) 219 | 220 | Counted 221 | (count [this] 222 | (.count this ndx)) 223 | 224 | Iterator 225 | (hasNext [this] 226 | (>= ndx 0)) 227 | (next [this] 228 | (let [i ndx] 229 | (set! ndx (.bumpIndex this i)) 230 | (.fetch this i)))) 231 | 232 | (defn ^counted-reverse-iterator new-counted-reverse-iterator 233 | ([^INode node opts] 234 | (->counted-reverse-iterator node (- (.getCnt node opts) 1) opts)) 235 | ([node i opts] 236 | (->counted-reverse-iterator node i opts))) 237 | 238 | (defn ^CountedSequence new-counted-reverse-seq 239 | ([node opts] 240 | (let [it (new-counted-reverse-iterator node opts)] 241 | (CountedSequence/create it (.index it) identity))) 242 | ([node i opts] 243 | (let [it (new-counted-reverse-iterator node i opts)] 244 | (CountedSequence/create it (.index it) identity)))) 245 | 246 | (defn vector-add [^INode n v i opts] 247 | (if (empty-node? n) 248 | (.newNode n v 1 nil nil 1 opts) 249 | (let [l (left-node n opts) 250 | p (.getCnt l opts)] 251 | (split 252 | (skew 253 | (if (<= i p) 254 | (revise n [:left (vector-add l v i opts)] opts) 255 | (revise n [:right (vector-add (right-node n opts) v (- i p 1) opts)] opts)) 256 | opts) 257 | opts)))) 258 | 259 | (defn vector-set [^INode n v i opts] 260 | (if (empty-node? n) 261 | (.newNode n v 1 nil nil 1 opts) 262 | (let [l (left-node n opts) 263 | p (.getCnt l opts)] 264 | (split 265 | (skew 266 | (cond 267 | (< i p) 268 | (revise n [:left (vector-set l v i opts)] opts) 269 | (> i p) 270 | (revise n [:right (vector-set (right-node n opts) v (- i p 1) opts)] opts) 271 | :else 272 | (revise n [:t2 v] opts)) 273 | opts) 274 | opts)))) 275 | 276 | (defn ^MapEntry get-entry [^INode this opts] (.getT2 this opts)) 277 | 278 | (defn key-of [^IMapEntry e] (.getKey e)) 279 | 280 | (defn value-of [^IMapEntry e] (.getValue e)) 281 | 282 | (defn map-cmpr [this x ^Comparator comparator opts] 283 | (.compare comparator x (.getKey (get-entry this opts)))) 284 | 285 | (defn resource-cmpr [this x opts] (map-cmpr this x (:comparator opts) opts)) 286 | 287 | (defn map-index-of [this x opts] 288 | (if (empty-node? this) 289 | 0 290 | (let [c (resource-cmpr this x opts)] 291 | (cond 292 | (< c 0) 293 | (map-index-of (left-node this opts) x opts) 294 | (= c 0) 295 | (.getCnt (left-node this opts) opts) 296 | :else 297 | (+ 1 298 | (.getCnt (left-node this opts) opts) 299 | (map-index-of (right-node this opts) x opts)))))) 300 | 301 | (defn ^counted-iterator new-map-entry-iterator 302 | ([^INode node x opts] 303 | (->counted-iterator node (map-index-of node x opts) (.getCnt node opts) opts))) 304 | 305 | (defn ^CountedSequence new-map-entry-seq 306 | ([node x opts] 307 | (let [it (new-map-entry-iterator node x opts)] 308 | (CountedSequence/create it (.index it) identity)))) 309 | 310 | (defn ^CountedSequence new-map-key-seq [node opts] 311 | (let [it (new-counted-iterator node opts)] 312 | (CountedSequence/create it (.index it) key-of))) 313 | 314 | (defn ^CountedSequence new-map-value-seq [node opts] 315 | (let [it (new-counted-iterator node opts)] 316 | (CountedSequence/create it (.index it) value-of))) 317 | 318 | (defn ^counted-reverse-iterator new-map-entry-reverse-iterator 319 | ([node x opts] 320 | (->counted-reverse-iterator node (map-index-of node x opts) opts))) 321 | 322 | (defn ^CountedSequence new-map-entry-reverse-seq 323 | ([node x opts] 324 | (let [it (new-map-entry-reverse-iterator node x opts)] 325 | (CountedSequence/create it (.index it) identity)))) 326 | 327 | (defn ^CountedSequence new-map-key-reverse-seq [node opts] 328 | (let [it (new-counted-reverse-iterator node opts)] 329 | (CountedSequence/create it (.index it) key-of))) 330 | 331 | (defn ^CountedSequence new-map-value-reverse-seq [node opts] 332 | (let [it (new-counted-reverse-iterator node opts)] 333 | (CountedSequence/create it (.index it) value-of))) 334 | 335 | (defn map-insert [^INode this ^MapEntry t-2 opts] 336 | (if (empty-node? this) 337 | (.newNode this t-2 1 nil nil 1 opts) 338 | (let [c (resource-cmpr this (.getKey t-2) opts)] 339 | (split (skew (cond 340 | (< c 0) 341 | (let [oldl (left-node this opts) 342 | l (map-insert oldl t-2 opts)] 343 | (revise this [:left l] opts)) 344 | (> c 0) 345 | (let [oldr (right-node this opts) 346 | r (map-insert oldr t-2 opts)] 347 | (revise this [:right r] opts)) 348 | :else 349 | (if (identical? (.getValue t-2) (.getValue (get-entry this opts))) 350 | this 351 | (revise this 352 | [:t2 (new MapEntry (.getKey (get-entry this opts)) (.getValue t-2))] 353 | opts))) opts) opts)))) 354 | 355 | (defn map-get-t2 [^INode this x opts] 356 | (if (empty-node? this) 357 | nil 358 | (let [c (resource-cmpr this x opts)] 359 | (cond 360 | (zero? c) (.getT2 this opts) 361 | (> c 0) (map-get-t2 (right-node this opts) x opts) 362 | :else (map-get-t2 (left-node this opts) x opts))))) 363 | 364 | (defn map-del [^INode this x opts] 365 | (if (empty-node? this) 366 | this 367 | (let [c (resource-cmpr this x opts)] 368 | (if (and (= c 0) (= 1 (.getLevel this opts))) 369 | (right-node this opts) 370 | (let [t (cond 371 | (> c 0) 372 | (revise this [:right (map-del (right-node this opts) x opts)] opts) 373 | (< c 0) 374 | (revise this [:left (map-del (left-node this opts) x opts)] opts) 375 | :else 376 | (let [^MapEntry p (predecessor-t2 this opts)] 377 | (revise this [:t2 p :left (map-del (left-node this opts) (.getKey p) opts)] opts))) 378 | t (decrease-level t opts) 379 | t (skew t opts) 380 | t (revise t [:right (skew (right-node t opts) opts)] opts) 381 | r (right-node t opts) 382 | t (if (empty-node? r) 383 | t 384 | (revise t [:right (revise r [:right (skew (right-node r opts) opts)] opts)] opts)) 385 | t (split t opts) 386 | t (revise t [:right (split (right-node t opts) opts)] opts)] 387 | t))))) 388 | 389 | (declare ->Node 390 | create-empty-node) 391 | 392 | (deftype Node [t2 ^Long level left right ^Long cnt] 393 | 394 | INode 395 | 396 | (newNode [this t2 level left right cnt opts] 397 | (->Node t2 level left right cnt)) 398 | 399 | (getT2 [this opts] t2) 400 | 401 | (getLevel [this opts] level) 402 | 403 | (getLeft [this opts] left) 404 | 405 | (getRight [this opts] right) 406 | 407 | (getCnt [this opts] cnt) 408 | 409 | (getNada [this] (create-empty-node))) 410 | 411 | (def emptyNode 412 | (->Node nil 0 nil nil 0)) 413 | 414 | (defn create-empty-node [] 415 | emptyNode) 416 | 417 | (defn snodev [^INode this opts] 418 | (if (empty-node? this) 419 | "" 420 | (str (snodev (.getLeft this opts) opts) 421 | " <" 422 | (.getT2 this opts) 423 | " " 424 | (.getLevel this opts) 425 | "> " 426 | (snodev (.getRight this opts) opts)))) 427 | 428 | (defn pnodev [this dsc opts] 429 | (println dsc (snodev this opts))) 430 | 431 | (definterface FlexVector 432 | (dropNode [i]) 433 | (addNode [i v])) 434 | 435 | (definterface IFactory 436 | (factoryId []) 437 | (instanceClass []) 438 | (qualified [t2 opts]) 439 | (sval [^aatree.nodes.INode inode opts]) 440 | (valueLength [^aatree.nodes.INode node 441 | opts]) 442 | (deserialize [^aatree.nodes.INode node 443 | ^java.nio.ByteBuffer buffer 444 | opts]) 445 | (writeValue [^aatree.nodes.INode node 446 | ^java.nio.ByteBuffer buffer 447 | opts]) 448 | (valueNode [^aatree.nodes.INode node 449 | opts])) 450 | 451 | (deftype factory-registry [by-id-atom by-class-atom]) 452 | 453 | (defn ^factory-registry create-factory-registry 454 | ([] 455 | (factory-registry. (atom {}) 456 | (atom {}))) 457 | ([^factory-registry fregistry] 458 | (factory-registry. (atom @(.-by_id_atom fregistry)) 459 | (atom @(.by_class_atom fregistry))))) 460 | 461 | (def default-factory-registry (create-factory-registry)) 462 | 463 | (definterface AAContext 464 | (classAtom []) 465 | (getDefaultFactory []) 466 | (setDefaultFactory [factory]) 467 | (refineInstance [inst])) 468 | 469 | (defn ^IFactory factory-for-id [id opts] 470 | (let [^factory-registry r (:factory-registry opts) 471 | _ (if (nil? r) (println "oh!")) 472 | f (@(.-by_id_atom r) id)] 473 | (if (nil? f) 474 | (let [^AAContext context (:aacontext opts)] 475 | (.getDefaultFactory context)) 476 | f))) 477 | 478 | (defn register-class [^AAContext aacontext ^IFactory factory] 479 | (let [clss (.instanceClass factory)] 480 | (if clss 481 | (swap! (.classAtom aacontext) assoc clss factory)))) 482 | 483 | (defn ^IFactory factory-for-class [^AAContext aacontext clss opts] 484 | (let [f (@(.classAtom aacontext) clss)] 485 | (if (nil? f) 486 | (let [^AAContext context (:aacontext opts)] 487 | (.getDefaultFactory context)) 488 | f))) 489 | 490 | (defn className [^Class c] (.getName c)) 491 | 492 | (defn ^IFactory factory-for-instance [inst opts] 493 | (let [^AAContext aacontext (:aacontext opts) 494 | inst (.refineInstance aacontext inst) 495 | clss (class inst) 496 | f (factory-for-class aacontext clss opts) 497 | q (.qualified f inst opts)] 498 | (if (nil? q) 499 | (throw (UnsupportedOperationException. (str "Unknown qualified durable class: " (className clss)))) 500 | q))) 501 | 502 | (defn register-factory [^factory-registry fregistry 503 | ^AAContext aacontext 504 | ^IFactory factory] 505 | (swap! (.-by-id-atom fregistry) assoc (.factoryId factory) factory) 506 | (register-class aacontext factory)) 507 | 508 | (definterface WrapperNode 509 | (svalAtom []) 510 | (blenAtom []) 511 | (bufferAtom []) 512 | (factory []) 513 | (nodeByteLength [opts]) 514 | (nodeWrite [buffer opts])) 515 | 516 | (defn node-byte-length [^WrapperNode wrapper-node opts] 517 | (.nodeByteLength wrapper-node opts)) 518 | 519 | (defn node-write [^WrapperNode wrapper-node buffer opts] 520 | (.nodeWrite wrapper-node buffer opts)) 521 | 522 | (defn ^IFactory get-factory [^WrapperNode wrapper-node] 523 | (.factory wrapper-node)) 524 | 525 | (defn get-buffer-atom [^WrapperNode wrapper-node] 526 | (.bufferAtom wrapper-node)) 527 | 528 | (defn ^java.nio.ByteBuffer get-buffer [^WrapperNode wrapper-node] 529 | @(.bufferAtom wrapper-node)) 530 | 531 | (defn str-val [^IFactory factory ^WrapperNode wrapper-node opts] 532 | (let [sval-atom (.svalAtom wrapper-node)] 533 | (if (nil? @sval-atom) 534 | (compare-and-set! sval-atom nil (.sval factory wrapper-node opts))) 535 | @sval-atom)) 536 | 537 | (defn default-sval [this ^INode inode opts] 538 | (pr-str (.getT2 inode opts))) 539 | 540 | (defn key-sval [this ^INode inode opts] 541 | (let [^MapEntry map-entry (.getT2 inode opts)] 542 | (pr-str (.getKey map-entry)))) 543 | 544 | (defn deserialize-sval [this ^WrapperNode wrapper-node ^ByteBuffer bb opts] 545 | (let [svl (.getInt bb) 546 | ^CharBuffer cb (.asCharBuffer bb) 547 | svc (char-array svl) 548 | _ (.get cb svc) 549 | sv (String. svc) 550 | _ (reset! (.svalAtom wrapper-node) sv) 551 | _ (.position bb (+ (.position bb) (* 2 svl)))] 552 | (read-string opts sv))) 553 | 554 | (defn default-valueLength [this ^WrapperNode wrapper-node opts] 555 | (+ 4 ;sval length 556 | (* 2 (count (str-val this wrapper-node opts))))) ;sval 557 | 558 | (defn default-write-value [^IFactory f 559 | ^WrapperNode wrapper-node 560 | ^ByteBuffer buffer 561 | opts] 562 | (let [^String sv (str-val f wrapper-node opts) 563 | svl (count sv) 564 | _ (.putInt buffer svl) 565 | ^CharBuffer cb (.asCharBuffer buffer)] 566 | (.put cb sv) 567 | (.position buffer (+ (* 2 svl) (.position buffer))))) 568 | 569 | (def ^AAContext vector-context 570 | (let [class-atom (atom {}) 571 | factory-atom (atom nil)] 572 | (reify AAContext 573 | (classAtom [this] class-atom) 574 | (getDefaultFactory [this] @factory-atom) 575 | (setDefaultFactory 576 | [this f] 577 | (compare-and-set! factory-atom nil f)) 578 | (refineInstance [this inst] inst)))) 579 | 580 | (def ^AAContext map-context 581 | (let [class-atom (atom {}) 582 | factory-atom (atom nil)] 583 | (reify AAContext 584 | (classAtom [this] class-atom) 585 | (getDefaultFactory [this] @factory-atom) 586 | (setDefaultFactory 587 | [this f] 588 | (compare-and-set! factory-atom nil f)) 589 | (refineInstance [this inst] 590 | (let [^MapEntry map-entry inst] 591 | (.getValue map-entry)))))) 592 | 593 | (def ^AAContext set-context 594 | (let [class-atom (atom {}) 595 | factory-atom (atom nil)] 596 | (reify AAContext 597 | (classAtom [this] class-atom) 598 | (getDefaultFactory [this] @factory-atom) 599 | (setDefaultFactory 600 | [this f] 601 | (compare-and-set! factory-atom nil f)) 602 | (refineInstance [this inst] 603 | (let [^MapEntry map-entry inst] 604 | (.getKey map-entry)))))) 605 | 606 | (defn vector-opts [opts] 607 | (assoc opts :aacontext vector-context)) 608 | 609 | (defn map-opts [opts] 610 | (assoc opts :aacontext map-context)) 611 | 612 | (defn set-opts [opts] 613 | (assoc opts :aacontext set-context)) 614 | 615 | (defn node-read [buffer opts] 616 | ((:node-read opts) buffer opts)) 617 | 618 | (register-factory 619 | default-factory-registry 620 | nil 621 | (reify IFactory 622 | (factoryId [this] (byte \n)) ;;;;;;;;;;;;;;;;;;;;;;;; n - nil content 623 | (instanceClass [this] nil) 624 | (qualified [this t2 opts] this) 625 | (valueNode [this node opts] nil))) 626 | 627 | (register-factory 628 | default-factory-registry 629 | vector-context 630 | (reify IFactory 631 | (factoryId [this] (byte \e)) ;;;;;;;;;;;;;;;;;;;;;; e - vector default factory 632 | (instanceClass [this] nil) 633 | (qualified [this t2 opts] this) 634 | (sval [this inode opts] 635 | (default-sval this inode opts)) 636 | (valueLength [this node opts] 637 | (default-valueLength this node opts)) 638 | (deserialize [this node bb opts] 639 | (deserialize-sval this node bb opts)) 640 | (writeValue [this node buffer opts] 641 | (default-write-value this node buffer opts)) 642 | (valueNode [this node opts] nil))) 643 | 644 | (.setDefaultFactory 645 | vector-context 646 | (factory-for-id 647 | (byte \e) 648 | {:factory-registry default-factory-registry})) 649 | 650 | (register-factory 651 | default-factory-registry 652 | map-context 653 | (reify IFactory 654 | (factoryId [this] (byte \p)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; p - map default factory 655 | (instanceClass [this] nil) 656 | (qualified [this t2 opts] this) 657 | (sval [this inode opts] 658 | (default-sval this inode opts)) 659 | (valueLength [this node opts] 660 | (default-valueLength this node opts)) 661 | (deserialize [this node bb opts] 662 | (let [^PersistentVector v (deserialize-sval this node bb opts) 663 | t2 (MapEntry. (.get v 0) (.get v 1))] 664 | t2)) 665 | (writeValue [this node buffer opts] 666 | (default-write-value this node buffer opts)) 667 | (valueNode [this node opts] nil))) 668 | 669 | (.setDefaultFactory 670 | map-context 671 | (factory-for-id 672 | (byte \p) 673 | {:factory-registry default-factory-registry})) 674 | 675 | (register-factory 676 | default-factory-registry 677 | set-context 678 | (reify IFactory 679 | (factoryId [this] (byte \q)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; q - set default factory 680 | (instanceClass [this] nil) 681 | (qualified [this t2 opts] this) 682 | (sval [this inode opts] 683 | (key-sval this inode opts)) 684 | (valueLength [this node opts] 685 | (default-valueLength this node opts)) 686 | (deserialize [this node bb opts] 687 | (let [k (deserialize-sval this node bb opts)] 688 | (MapEntry. k k))) 689 | (writeValue [this node buffer opts] 690 | (default-write-value this node buffer opts)) 691 | (valueNode [this node opts] nil))) 692 | 693 | (.setDefaultFactory 694 | set-context 695 | (factory-for-id 696 | (byte \q) 697 | {:factory-registry default-factory-registry})) 698 | 699 | (defn ^BitSet compute-cs256 [^ByteBuffer bb] 700 | (let [^BitSet bs (BitSet. 256) 701 | len (.remaining bb)] 702 | (reduce (fn [^BitSet bitset i] 703 | (let [bbv (- (.get bb) Byte/MIN_VALUE) 704 | j (mod (+ bbv (* i 7)) 256)] 705 | (.flip bitset j)) 706 | bitset) 707 | bs 708 | (range len)) 709 | bs)) 710 | 711 | (defn put-cs256 [^ByteBuffer bb ^BitSet cs256] 712 | (let [la (.toLongArray cs256) 713 | lal (alength la) 714 | r (range (- 4 lal)) 715 | ^LongBuffer lb (.asLongBuffer bb)] 716 | (.put lb la) 717 | (reduce (fn [a b] (.put lb 0)) 0 r)) 718 | (.position bb (+ (.position bb) 32))) 719 | 720 | (defn ^BitSet get-cs256 [^ByteBuffer bb] 721 | (let [la (long-array 4) 722 | _ (.get (.asLongBuffer bb) (longs la)) 723 | bs (BitSet/valueOf (longs la))] 724 | (.position bb (+ (.position bb) 32)) 725 | bs)) 726 | 727 | (defn same? [val opts] 728 | (if (instance? INoded val) 729 | (let [vopts (get-opts val)] 730 | (if (and (= (:new-vector opts) (:new-vector vopts)) 731 | (= (:db-file opts) (:db-file vopts))) 732 | true 733 | false)) 734 | false)) 735 | 736 | (defn transcribe-vector [val opts] 737 | (reduce conj ((:new-vector opts) opts) (seq val))) 738 | 739 | (defn transcribe-sorted-map [val opts] 740 | (reduce conj ((:new-sorted-map opts) opts) (seq val))) 741 | 742 | (defn transcribe-sorted-set [val opts] 743 | (reduce conj ((:new-sorted-set opts) opts) (seq val))) 744 | 745 | (defn transcriber [val opts] 746 | (if (instance? java.util.List val) 747 | (if (instance? clojure.lang.IPersistentVector val) 748 | (if (same? val opts) 749 | val 750 | (transcribe-vector val opts)) 751 | val) 752 | (if (instance? java.util.Map val) 753 | (if (same? val opts) 754 | val 755 | (transcribe-sorted-map val opts)) 756 | (if (instance? java.util.Set val) 757 | (if (same? val opts) 758 | val 759 | (transcribe-sorted-set val opts)) 760 | val)))) 761 | -------------------------------------------------------------------------------- /src/aatree/null_db_cache_trait.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.null-db-cache-trait 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer))) 4 | 5 | (defn null-db-cache [this] 6 | (-> this 7 | (assoc 8 | :block-read 9 | (fn [db block-nbr block-length] 10 | (if (> block-length (db-block-size db)) 11 | (throw (Exception. (str "block length is too big:" block-length)))) 12 | (let [^ByteBuffer byte-buffer (ByteBuffer/allocate block-length)] 13 | (db-file-read db byte-buffer (* block-nbr (db-block-size db))) 14 | (.flip byte-buffer) 15 | byte-buffer))) 16 | (assoc 17 | :block-write 18 | (fn [db block-nbr ^ByteBuffer byte-buffer] 19 | (check-buffer-size db byte-buffer) 20 | (db-file-write db byte-buffer (* block-nbr (db-block-size db))))) 21 | (assoc 22 | :block-clear 23 | (fn [db block-nbr])) 24 | )) 25 | -------------------------------------------------------------------------------- /src/aatree/unique_timestamp.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.unique-timestamp) 2 | 3 | (set! *warn-on-reflection* true) 4 | 5 | (def ^:private ts-atom (atom (bit-shift-left (System/currentTimeMillis) 10))) 6 | 7 | (defn old-timestamp [] 8 | @ts-atom) 9 | 10 | (defn old-time-millis [] 11 | (bit-shift-right (old-timestamp) 10)) 12 | 13 | (defn- new-time-millis [old-time-millis] 14 | (let [current-time-millis (System/currentTimeMillis)] 15 | (if (not= current-time-millis old-time-millis) 16 | current-time-millis 17 | (do 18 | (Thread/yield) 19 | (recur old-time-millis))))) 20 | 21 | (defn new-timestamp [] 22 | (swap! ts-atom 23 | (fn [old-timestamp] 24 | (let [current-time-millis (System/currentTimeMillis) 25 | old-time-millis (bit-shift-right old-timestamp 10) 26 | old-count (bit-and old-timestamp 1023)] 27 | (if (= current-time-millis old-time-millis) 28 | (if (= old-count 1023) 29 | (bit-shift-left (new-time-millis old-time-millis) 10) 30 | (+ old-timestamp 1)) 31 | (bit-shift-left current-time-millis 10)))))) -------------------------------------------------------------------------------- /src/aatree/virtual_nodes.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.virtual-nodes 2 | (:require [aatree.nodes :refer :all]) 3 | (:import (java.nio ByteBuffer) 4 | (aatree.nodes IFactory WrapperNode) 5 | (clojure.lang RT) 6 | (aatree AAVector AAMap AASet) 7 | (java.lang.ref WeakReference))) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | (declare ->VirtualNode 12 | ^aatree.nodes.INode get-virtual-data 13 | create-virtual-empty-node 14 | virtual-byte-length 15 | virtual-write 16 | virtual-as-reference) 17 | 18 | (deftype VirtualNode [node-id 19 | weak-data-atom 20 | hard-data-atom 21 | sval-atom 22 | blen-atom 23 | buffer-atom 24 | factory] 25 | 26 | aatree.nodes.INode 27 | 28 | (newNode [this t2 level left right cnt opts] 29 | (let [d (->Node t2 level left right cnt) 30 | f (factory-for-instance t2 opts) 31 | node-id ((:db-new-node-id opts) opts) 32 | vn (->VirtualNode node-id 33 | (atom nil) 34 | (atom d) 35 | (atom nil) 36 | (atom nil) 37 | (atom nil) 38 | f)] 39 | vn)) 40 | 41 | (getT2 [this opts] (.getT2 (get-virtual-data this opts) opts)) 42 | 43 | (^Long getLevel [this opts] (.getLevel (get-virtual-data this opts) opts)) 44 | 45 | (getLeft [this opts] (.getLeft (get-virtual-data this opts) opts)) 46 | 47 | (getRight [this opts] (.getRight (get-virtual-data this opts) opts)) 48 | 49 | (^Long getCnt [this opts] (.getCnt (get-virtual-data this opts) opts)) 50 | 51 | (getNada [this] (create-virtual-empty-node)) 52 | 53 | WrapperNode 54 | 55 | (svalAtom [this] (.-sval-atom this)) 56 | 57 | (blenAtom [this] (.-blen-atom this)) 58 | 59 | (bufferAtom [this] (.-buffer-atom this)) 60 | 61 | (factory [this] (.-factory this)) 62 | 63 | (nodeByteLength [this opts] (virtual-byte-length this opts)) 64 | 65 | (nodeWrite [this buffer opts] (virtual-write this buffer opts))) 66 | 67 | (defn- get-weak-data-atom [^VirtualNode this] (.weak-data-atom this)) 68 | 69 | (defn ^VirtualNode value-node [^VirtualNode virtual-node opts] 70 | (if (empty-node? virtual-node) 71 | virtual-node) 72 | (let [^IFactory f (.factory virtual-node) 73 | vn (.valueNode f virtual-node opts)] 74 | (if vn 75 | vn 76 | (.getNada virtual-node)))) 77 | 78 | (defn- unchanged? [^VirtualNode virtual-node] 79 | @(.-buffer_atom virtual-node)) 80 | 81 | (defn- search-unchanged [unchanged ^VirtualNode virtual-node opts] 82 | (if (empty-node? virtual-node) 83 | unchanged 84 | (if (unchanged? virtual-node) 85 | (conj unchanged (.-node-id virtual-node)) 86 | (-> unchanged 87 | (search-unchanged (value-node virtual-node opts) opts) 88 | (search-unchanged (left-node virtual-node opts) opts) 89 | (search-unchanged (right-node virtual-node opts) opts))))) 90 | 91 | (defn- dropped-blocks [unused ^VirtualNode virtual-node unchanged opts] 92 | (if (empty-node? virtual-node) 93 | unused 94 | (if (contains? unchanged (.-node-id virtual-node)) 95 | unused 96 | (let [^ByteBuffer bb @(.-buffer_atom virtual-node) 97 | unused (if (and bb (= 1 (.get bb (+ 1 8 4)))) 98 | (conj unused (.getLong bb (int (+ 1 8 4 1)))) 99 | unused) 100 | unused (dropped-blocks unused (value-node virtual-node opts) unchanged opts) 101 | unused (dropped-blocks unused (left-node virtual-node opts) unchanged opts) 102 | unused (dropped-blocks unused (right-node virtual-node opts) unchanged opts)] 103 | unused)))) 104 | 105 | (defn find-dropped-blocks [old-node new-node opts] 106 | (let [unchanged (search-unchanged #{} new-node opts)] 107 | (dropped-blocks [] old-node unchanged opts))) 108 | 109 | (defn- new-byte-length [^VirtualNode virtual-node opts] 110 | (+ 1 ;factory id 111 | 8 ;node id 112 | 4 ;byte length - 13 113 | 1 ;reference flag 114 | (virtual-byte-length (left-node virtual-node opts) opts) ;left node 115 | 4 ;level 116 | 4 ;cnt 117 | (.valueLength (get-factory virtual-node) virtual-node opts) ;t2 118 | (virtual-byte-length (right-node virtual-node opts) opts))) ;right node 119 | 120 | (defn shrinker [^VirtualNode virtual-node opts] 121 | (let [blen (new-byte-length virtual-node opts)] 122 | (if (>= (:db-block-size opts) blen) 123 | blen 124 | (let [largest-node (left-node virtual-node opts) 125 | nlen (virtual-byte-length largest-node opts) 126 | nx-node (right-node virtual-node opts) 127 | largest-node (if (< nlen (virtual-byte-length nx-node opts)) 128 | nx-node 129 | largest-node) 130 | nlen (virtual-byte-length largest-node opts) 131 | nx-node (value-node virtual-node opts) 132 | largest-node (if (< nlen (virtual-byte-length nx-node opts)) 133 | nx-node 134 | largest-node)] 135 | (virtual-as-reference largest-node opts) 136 | (recur virtual-node opts))))) 137 | 138 | (defn virtual-byte-length [^VirtualNode virtual-node opts] 139 | (if (empty-node? virtual-node) 140 | 1 141 | (let [a (.blenAtom virtual-node) 142 | blen @a] 143 | (if (nil? blen) 144 | (let [^ByteBuffer bb @(.bufferAtom virtual-node) 145 | blen (if bb 146 | (.limit bb) 147 | (shrinker virtual-node opts))] ;right node 148 | (compare-and-set! a nil blen))) 149 | @a))) 150 | 151 | (defn virtual-write [^VirtualNode virtual-node ^ByteBuffer buffer opts] 152 | (let [^IFactory f (.factory virtual-node) 153 | ^ByteBuffer old-bb (get-buffer virtual-node)] 154 | (if old-bb 155 | (let [new-bb (.duplicate old-bb) 156 | lim (.limit new-bb) 157 | ba (byte-array lim)] 158 | (.get new-bb ba) 159 | (.put buffer ba)) 160 | (let [new-bb (.slice buffer)] 161 | (if (= (byte \n) (.factoryId f)) 162 | (.put buffer (byte (.factoryId f))) 163 | (do 164 | (.put buffer (byte (.factoryId f))) 165 | (.putLong buffer (.-node_id virtual-node)) 166 | (.putInt buffer (- (virtual-byte-length virtual-node opts) 13)) 167 | (.put buffer (byte 0)) 168 | (virtual-write (left-node virtual-node opts) buffer opts) 169 | (.putInt buffer (.getLevel virtual-node opts)) 170 | (.putInt buffer (.getCnt virtual-node opts)) 171 | (.writeValue f virtual-node buffer opts) 172 | (virtual-write (right-node virtual-node opts) buffer opts))) 173 | (.limit new-bb (virtual-byte-length virtual-node opts)) 174 | (compare-and-set! (get-buffer-atom virtual-node) nil new-bb) 175 | (reset! (.-hard-data-atom virtual-node) nil) 176 | (reset! (.-weak-data-atom virtual-node) nil) 177 | )))) 178 | 179 | (defn virtual-as-reference [^VirtualNode virtual-node opts] 180 | (let [db-block-size (:db-block-size opts) 181 | bl (virtual-byte-length virtual-node opts) 182 | _ (if (< db-block-size bl) 183 | (throw (Exception. (str "byte-length exceeds block size: " bl)))) 184 | ^ByteBuffer nbb (ByteBuffer/allocate bl) 185 | _ (virtual-write virtual-node nbb opts) 186 | _ (.flip nbb) 187 | block-nbr ((:db-allocate opts) opts) 188 | _ ((:block-write opts) opts (long block-nbr) nbb) 189 | _ (.flip nbb) 190 | blen (+ 1 ;bode id 191 | 8 ;node-id 192 | 4 ;byte-length - 13 193 | 1 ;reference flag 194 | 8 ;block position 195 | 4 ;block length 196 | 32) ;checksum 197 | ^ByteBuffer bb (ByteBuffer/allocate blen) 198 | ^IFactory f (.factory virtual-node)] 199 | (.put bb (byte (.factoryId f))) 200 | (.putLong bb (.-node_id virtual-node)) 201 | (.putInt bb (- blen 13)) 202 | (.put bb (byte 1)) 203 | (.putLong bb block-nbr) 204 | (.putInt bb bl) 205 | (put-cs256 bb (compute-cs256 nbb)) 206 | (.flip bb) 207 | (reset! (get-buffer-atom virtual-node) bb) 208 | (reset! (.blenAtom virtual-node) blen) 209 | (reset! (.-hard-data-atom virtual-node) nil) 210 | (reset! (.-weak-data-atom virtual-node) nil))) 211 | 212 | (defn virtual-read [^ByteBuffer buffer opts] 213 | (let [^ByteBuffer bb (.slice buffer) 214 | id (.get bb)] 215 | (if (= id (byte \n)) 216 | (do (.get buffer) 217 | (create-virtual-empty-node)) 218 | (let [f (factory-for-id id opts) 219 | bb (.slice buffer) 220 | _ (.get buffer) 221 | node-id (.getLong buffer) 222 | lm13 (.getInt buffer) 223 | _ (.position buffer (+ lm13 (.position buffer))) 224 | blen (+ 1 8 4 lm13) 225 | _ (.limit bb blen)] 226 | (->VirtualNode 227 | node-id 228 | (atom nil) 229 | (atom nil) 230 | (atom nil) 231 | (atom blen) 232 | (atom bb) 233 | f))))) 234 | 235 | (defn fetch [^ByteBuffer bb opts] 236 | (let [block-nbr (.getLong bb) 237 | block-length (.getInt bb) 238 | ocs (get-cs256 bb) 239 | ^ByteBuffer nbb ((:block-read opts) opts (long block-nbr) block-length) 240 | cs (compute-cs256 nbb) 241 | _ (if (not= ocs cs) 242 | (throw (Exception. (str "corrupted database, fetching block " block-nbr)))) 243 | ] 244 | (.flip nbb) 245 | (.position nbb (+ 1 8 4 1)) 246 | nbb)) 247 | 248 | (defn- make-data [^VirtualNode this opts] 249 | (let [bb (.slice (get-buffer this)) 250 | _ (.position bb 13) 251 | reference-flag (.get bb) 252 | ^ByteBuffer bb (if (= reference-flag 0) 253 | bb 254 | (fetch bb opts)) 255 | left (virtual-read bb opts) 256 | level (long (.getInt bb)) 257 | cnt (long (.getInt bb)) 258 | t2 (.deserialize (get-factory this) this bb opts) 259 | right (virtual-read bb opts) 260 | data (->Node t2 level left right cnt)] 261 | data)) 262 | 263 | (defn- get-weak-data [^VirtualNode this opts] 264 | (let [wda (.-weak_data_atom this) 265 | ^WeakReference wr @wda] 266 | (if wr 267 | (.get wr) 268 | nil))) 269 | 270 | (defn- get-virtual-data [^VirtualNode this opts] 271 | (if (empty-node? this) 272 | emptyNode 273 | (let [d @(.-hard_data_atom this)] 274 | (if d 275 | d 276 | (let [node-id (.-node-id this) 277 | wd (get-weak-data this opts) 278 | data (if wd 279 | wd 280 | (make-data this opts))] 281 | (if (nil? wd) 282 | (reset! (.-weak_data_atom this) (WeakReference. data))) 283 | data))))) 284 | 285 | (def ^VirtualNode emptyVirtualNode 286 | (->VirtualNode 287 | 0 288 | (atom (WeakReference. emptyNode)) 289 | (atom nil) 290 | (atom nil) 291 | (atom 1) 292 | (atom nil) 293 | (factory-for-id 294 | (byte \n) 295 | {:factory-registry default-factory-registry}))) 296 | 297 | (defn create-virtual-empty-node 298 | [] emptyVirtualNode) 299 | 300 | (defn load-virtual-vector [buffer opts] 301 | (if (:factory-registry opts) 302 | (let [r (vector-opts opts)] 303 | (new AAVector (node-read buffer r) r)) 304 | (let [r (assoc opts :factory-registry default-factory-registry) 305 | r (vector-opts r)] 306 | (new AAVector (node-read buffer r) r)))) 307 | 308 | (defn load-virtual-sorted-map [buffer opts] 309 | (let [r opts 310 | r (if (:comparator r) 311 | r 312 | (assoc r :comparator RT/DEFAULT_COMPARATOR)) 313 | r (if (:factory-registry r) 314 | r 315 | (assoc r :factory-registry default-factory-registry)) 316 | r (map-opts r)] 317 | (new AAMap (node-read buffer r) r))) 318 | 319 | (defn load-virtual-sorted-set [buffer opts] 320 | (let [r opts 321 | r (if (:comparator r) 322 | r 323 | (assoc r :comparator RT/DEFAULT_COMPARATOR)) 324 | r (if (:factory-registry r) 325 | r 326 | (assoc r :factory-registry default-factory-registry)) 327 | r (set-opts r)] 328 | (new AASet 329 | (new AAMap (node-read buffer r) r)))) 330 | -------------------------------------------------------------------------------- /src/aatree/yearling.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.yearling 2 | (:require [aatree.core :refer :all] 3 | [aatree.nodes :refer :all] 4 | [aatree.db-file-trait :refer :all] 5 | [aatree.lru-db-cache-trait :refer :all] 6 | [aatree.db-chan-trait :refer :all]) 7 | (:import (java.nio ByteBuffer) 8 | (java.util BitSet) 9 | (java.io File))) 10 | 11 | (set! *warn-on-reflection* true) 12 | 13 | (declare yearling-release 14 | yearling-process-pending) 15 | 16 | (defn- max-blocks [this] (quot (:max-db-size this) (:db-block-size this))) 17 | 18 | (defn- max-allocated-longs [this] (quot (+ (max-blocks this) 7) 8)) 19 | 20 | (defn- yearling-new-node-id [this] 21 | (swap! 22 | (:last-node-id-atom this) 23 | (fn [old] (+ old 1)))) 24 | 25 | (defn- release-dropped-blocks [this old-uber-map uber-map] 26 | (let [dropped-blocks ((:find-dropped-blocks this) 27 | (get-inode old-uber-map) 28 | (get-inode uber-map) 29 | this)] 30 | (if (empty? dropped-blocks) 31 | uber-map 32 | (do 33 | (reduce (fn [_ block-position] (yearling-release this block-position)) 34 | nil 35 | dropped-blocks) 36 | (recur this uber-map uber-map))))) 37 | 38 | (defn- yearling-updater [this app-updater] 39 | (let [old-uber-map (update-get this) 40 | db-block-size (:db-block-size this) 41 | mx-allocated-longs (max-allocated-longs this) 42 | block-position (* db-block-size (mod (get-transaction-count this) 2)) 43 | _ (swap! 44 | (:transaction-count-atom this) 45 | (fn [old] (+ old 1))) 46 | max-db-size (:max-db-size this)] 47 | (vreset! (:time-millis-volatile this) (System/currentTimeMillis)) 48 | (yearling-process-pending this (:db-pending-age this) (:db-pending-count this)) 49 | (app-updater this) 50 | (let [uber-map (update-get this) 51 | 52 | uber-map (release-dropped-blocks this old-uber-map uber-map) 53 | map-size (byte-length uber-map) 54 | _ (when (< db-block-size (+ 4 8 4 4 8 8 map-size (* mx-allocated-longs 8) 32)) 55 | ((:as-reference this) (get-inode uber-map) this)) 56 | map-size (byte-length uber-map) 57 | _ (if (< db-block-size (+ 4 8 4 4 8 8 map-size (* mx-allocated-longs 8) 32)) 58 | (throw (Exception. (str "block-size exceeded on write: " map-size)))) 59 | 60 | map-size (byte-length uber-map) 61 | allocated-long-array (.toLongArray (get-allocated-bit-set this)) 62 | ala-len (alength allocated-long-array) 63 | _ (if (< mx-allocated-longs ala-len) 64 | (throw 65 | (Exception. 66 | (str "allocated size exceeded on write: " mx-allocated-longs ", " ala-len)))) 67 | ^ByteBuffer bb (ByteBuffer/allocate db-block-size)] 68 | (vreset! (:db-update-vstate this) uber-map) 69 | (.putInt bb db-block-size) 70 | (.putLong bb max-db-size) 71 | (.putInt bb map-size) 72 | (.putInt bb ala-len) 73 | (.putLong bb (get-transaction-count this)) 74 | (.putLong bb (get-last-node-id this)) 75 | (put-aa bb uber-map) 76 | (.put (.asLongBuffer bb) allocated-long-array) 77 | (.position bb (+ (.position bb) (* ala-len 8))) 78 | (put-cs256 bb (compute-cs256 (.flip (.duplicate bb)))) 79 | (.flip bb) 80 | ((:db-file-write-root this) bb (long block-position))))) 81 | 82 | (defn yearling-null-updater [this]) 83 | 84 | (defn- yearling-new [this] 85 | (let [this (assoc this :transaction-count-atom (atom 0)) 86 | ^BitSet allocated (BitSet.) 87 | _ (.set allocated 0) 88 | _ (.set allocated 1) 89 | this (assoc this :allocated-bit-set allocated) 90 | uber-map (new-sorted-map this) 91 | uber-map (assoc uber-map :release-pending (new-vector this)) 92 | db-update-vstate (:db-update-vstate this) 93 | _ (vreset! db-update-vstate uber-map) 94 | _ (yearling-updater this yearling-null-updater) 95 | _ (yearling-updater this yearling-null-updater) 96 | uber-map @db-update-vstate] 97 | (vreset! db-update-vstate nil) 98 | [this uber-map])) 99 | 100 | (defn- yearling-read [this block-position] 101 | (let [db-block-size (:db-block-size this) 102 | max-db-size (:max-db-size this) 103 | ^ByteBuffer bb (ByteBuffer/allocate db-block-size) 104 | _ (.limit bb (+ 4 8 4 4 8 8)) 105 | _ (db-file-read this bb (long block-position)) 106 | _ (.flip bb)] 107 | (if (not= db-block-size (.getInt bb)) 108 | nil 109 | (if (not= max-db-size (.getLong bb)) 110 | nil 111 | (let [map-size (.getInt bb) 112 | ala-len (.getInt bb) 113 | mx-allocated-longs (max-allocated-longs this) 114 | _ (if (< mx-allocated-longs ala-len) 115 | (throw (Exception. "allocated size exceeded on read"))) 116 | _ (if (< db-block-size (+ 4 8 4 4 8 8 map-size (* mx-allocated-longs 8) 32)) 117 | (throw (Exception. "block-size exceeded on read"))) 118 | transaction-count (.getLong bb) 119 | last-node-id (.getLong bb) 120 | input-size (+ (.limit bb) map-size (* ala-len 8) 32) 121 | _ (.limit bb input-size) 122 | _ (db-file-read this bb (long (+ block-position 4 8 4 4 8 8))) 123 | _ (.flip bb) 124 | csp (- input-size 32) 125 | _ (.limit bb csp) 126 | cs (compute-cs256 bb) 127 | _ (.limit bb input-size) 128 | ocs (get-cs256 bb) 129 | _ (.position bb (+ 4 8 4 4 8 8)) 130 | uber-map (load-sorted-map bb this) 131 | la (long-array ala-len) 132 | _ (.get (.asLongBuffer bb) (longs la)) 133 | allocated (BitSet/valueOf (longs la))] 134 | (if (not= cs ocs) 135 | nil 136 | {:transaction-count transaction-count 137 | :uber-map uber-map 138 | :allocated allocated 139 | :last-node-id last-node-id})))))) 140 | 141 | (defn- choose [this state0 state1] 142 | (let [state (if state0 143 | (if state1 144 | (if (> (:transaction-count state0) (:transaction-count state1)) 145 | state0 146 | state1) 147 | state0) 148 | (if state1 149 | state1 150 | (throw (Exception. "corrupted database")))) 151 | this (assoc this :transaction-count-atom (atom (:transaction-count state))) 152 | this (assoc this :allocated-bit-set (:allocated state))] 153 | (reset! (:last-node-id-atom this) (:last-node-id state)) 154 | [this (:uber-map state)])) 155 | 156 | (defn- yearling-old [this] 157 | (let [db-block-size (:db-block-size this) 158 | state0 (yearling-read this 0) 159 | state1 (yearling-read this db-block-size)] 160 | (choose this state0 state1))) 161 | 162 | (defn- yearling-allocated [this] 163 | (let [^BitSet allocated (get-allocated-bit-set this)] 164 | (.cardinality allocated))) 165 | 166 | (defn- yearling-allocate [this] 167 | (let [^BitSet allocated (get-allocated-bit-set this) 168 | avail (.nextClearBit allocated 0)] 169 | (.set allocated avail) 170 | avail)) 171 | 172 | (defn- yearling-release [this block-nbr] 173 | (let [vec (new-vector this) 174 | vec (conj vec (get-time-millis this) (get-transaction-count this) block-nbr)] 175 | (if (not (.get (get-allocated-bit-set this) block-nbr)) 176 | (throw (Exception. (str "block has not been allocated: " block-nbr " " (:db-block-size this))))) 177 | (update-assoc-in! this [:release-pending] (conj (update-get-in this [:release-pending]) vec)) 178 | (block-clear this block-nbr))) 179 | 180 | (defn- yearling-process-pending [this age trans] 181 | (when-let [release-pending (update-get-in this [:release-pending])] 182 | (and release-pending (not (empty? release-pending)) 183 | (let [allocated (get-allocated-bit-set this) 184 | oldest (release-pending 0)] 185 | (when (and (<= (+ (oldest 0) age) (get-time-millis this)) 186 | (<= (+ (oldest 1) trans) (get-transaction-count this))) 187 | (if (not (.get allocated (oldest 2))) 188 | (throw (Exception. (str "already available: " (oldest 2))))) 189 | (.clear allocated (oldest 2)) 190 | (update-assoc-in! this [:release-pending] (dropn release-pending 0)) 191 | (recur this age trans)))))) 192 | 193 | (defn yearling-open 194 | ([file] (yearling-open {} file)) 195 | ([this ^File file] 196 | (let [this (-> this 197 | (db-file-open file) 198 | (assoc :db-new-node-id yearling-new-node-id) 199 | (assoc-default :db-block-size 500000) 200 | (assoc-default :max-db-size 100000000000) 201 | (default :create-db-chan db-chan) 202 | (default :block-clear lru-db-cache) 203 | (assoc :db-allocated yearling-allocated) 204 | (assoc :db-allocate yearling-allocate) 205 | (assoc :db-release yearling-release) 206 | (assoc :db-process-pending yearling-process-pending) 207 | (assoc-default :db-pending-age 0) 208 | (assoc-default :db-pending-count 2) 209 | (default :new-sorted-map virtual-opts) 210 | (assoc :db-updater yearling-updater) 211 | (assoc :last-node-id-atom (atom 0)) 212 | (assoc :time-millis-volatile (volatile! 0))) 213 | [this db-state] (choice this db-file-empty? yearling-new yearling-old)] 214 | (create-db-chan this db-state)))) 215 | -------------------------------------------------------------------------------- /test/aatree/adler32_example.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.adler32-example 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.util.zip Adler32) 4 | (java.nio ByteBuffer) 5 | (java.io File))) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | (def opts (lazy-opts)) 10 | (def empty-vec (new-vector opts)) 11 | 12 | (let [lv1 (conj empty-vec 1 2 3) 13 | bb-len (+ (byte-length lv1) 8) 14 | ^ByteBuffer bb (ByteBuffer/allocate bb-len) 15 | _ (put-aa bb lv1) 16 | ^Adler32 adler32 (Adler32.) 17 | ^ByteBuffer abb (.flip (.duplicate bb))] 18 | (.update adler32 abb) 19 | (.putLong bb (.getValue adler32)) 20 | (.flip bb) 21 | (file-save bb (File. "adler32-example.lazy"))) 22 | 23 | (let [^ByteBuffer bb (file-load (File. "adler32-example.lazy")) 24 | csp (- (.limit bb) 8) 25 | ^ByteBuffer abb (.limit (.duplicate bb) csp) 26 | ^Adler32 adler32 (Adler32.) 27 | _ (.update adler32 abb) 28 | cs (.getValue adler32) 29 | ocs (.getLong bb csp) 30 | lv2 (if (= cs ocs) 31 | (load-vector bb opts) 32 | (throw (java.lang.Exception. "Checksum does not match")))] 33 | (println lv2)); -> [1 2 3] 34 | -------------------------------------------------------------------------------- /test/aatree/basic_sorted_map_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.basic-sorted-map-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (def opts (basic-opts)) 7 | 8 | (def bm1 (conj (new-sorted-map opts) {:dog "Jack" :cat "Sammy" :rabbit "Henry"})) 9 | (println bm1); -> {:cat Sammy, :dog Jack, :rabbit Henry} 10 | 11 | (println (nth bm1 1)); [:dog Jack] 12 | 13 | (println (rseq bm1)); -> ([:rabbit Henry] [:dog Jack] [:cat Sammy]) 14 | -------------------------------------------------------------------------------- /test/aatree/basic_sorted_set_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.basic-sorted-set-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (def opts (basic-opts)) 7 | 8 | (def bs1 (conj (new-sorted-set opts) :dog :cat :rabbit)) 9 | (println bs1); -> #{:cat :dog :rabbit} 10 | 11 | (println (nth bs1 1)); -> :dog 12 | 13 | (println (rseq bs1)); -> (:rabbit :dog :cat) 14 | -------------------------------------------------------------------------------- /test/aatree/basic_vector_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.basic-vector-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (def opts (basic-opts)) 7 | 8 | (def bv1 (conj (new-vector opts) 1 2 3)) 9 | (println bv1); -> [1 2 3] 10 | 11 | (def bv2 (addn bv1 0 0)) 12 | (println bv2); -> [0 1 2 3] 13 | 14 | (def bv3 (addn bv2 3 20)) 15 | (println bv3); -> [0 1 2 20 3] 16 | 17 | (def bv4 (dropn bv3 1)) 18 | (println bv4); -> [0 2 20 3] 19 | 20 | (def s1 (seq bv4)) 21 | (println s1); -> (0 2 20 3) 22 | (println (count s1)); -> 4 23 | 24 | (def s2 (next s1)) 25 | (println s2); -> (2 20 3) 26 | (println (count s2)); -> 3 27 | 28 | (println (rseq bv4)); -> (3 20 2 0) 29 | -------------------------------------------------------------------------------- /test/aatree/calf_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.calf-test 2 | (:require [clojure.test :refer :all] 3 | [aatree.core :refer :all] 4 | [aatree.calf :refer :all] 5 | [aatree.closer-trait :refer :all]) 6 | (:import (java.io File))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (deftest calf 11 | (.delete (File. "calf-test.calf")) 12 | 13 | (let [calf (calf-open (File. "calf-test.calf") 10000) 14 | app-map (db-get-in calf [:app-map]) 15 | _ (is (= (get-transaction-count calf) 2)) 16 | _ (is (= app-map nil)) 17 | _ (db-update calf 18 | (fn [db] 19 | (update-assoc-in! 20 | db 21 | [:app-map :fun] 22 | "Clojure"))) 23 | fun (db-get-in calf [:app-map :fun]) 24 | _ (is (= fun "Clojure")) 25 | _ (is (= (get-transaction-count calf) 3)) 26 | _ (close-components calf)]) 27 | 28 | (let [calf (calf-open (File. "calf-test.calf") 10000) 29 | fun (db-get-in calf [:app-map :fun]) 30 | _ (is (= (get-transaction-count calf) 3)) 31 | _ (is (= fun "Clojure")) 32 | _ (close-components calf)])) 33 | -------------------------------------------------------------------------------- /test/aatree/closer_trait_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.closer-trait-test 2 | (:require [aatree.closer-trait :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (close-components {}) 7 | 8 | (defn close-a [this] (println " close a")) 9 | (defn close-b [this] (println " close b")) 10 | (defn close-c [this] (println " close c")) 11 | 12 | (let [this (open-component {} "a" close-a) 13 | this (open-component this "b" close-b) 14 | this (open-component this "c" close-c)] 15 | (println "first close") 16 | (close-components this) 17 | (println "second close") 18 | (close-components this)) 19 | -------------------------------------------------------------------------------- /test/aatree/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.core-test 2 | (:require [clojure.test :refer :all] 3 | [aatree.core :refer :all] 4 | [collection-check :refer :all] 5 | [clojure.test.check.generators :as gen]) 6 | (:import (java.nio ByteBuffer))) 7 | 8 | (def x (new-sorted-map (basic-opts))) 9 | (println (.entryAt x 1)) 10 | (println (.containsKey x 1)) 11 | (println (type x)) 12 | (def x1 (.assoc x 1 1000)) 13 | (println (.entryAt x1 1)) 14 | (println (.containsKey x1 1)) 15 | (def x2 (.without x1 1)) 16 | (println (.entryAt x2 1)) 17 | (println (.containsKey x2 1)) 18 | (println (.seq x1)) 19 | (def x3 (.empty x1)) 20 | (println (.entryAt x3 1)) 21 | (println (.containsKey x3 1)) 22 | (println (.seq x3)) 23 | (def x12 (.assoc x1 2 1002)) 24 | (println (.entryAt x12 1)) 25 | (println (.containsKey x12 1)) 26 | (println (.seq x12)) 27 | (println (.rseq x12)) 28 | (println (.count x12)) 29 | (def x123 (.assoc x12 3 1003)) 30 | (println x123) 31 | (println (.seqFrom x123 2 true)) 32 | (println (.seqFrom x123 2 false)) 33 | 34 | (println) 35 | (def t1 (new-sorted-map (basic-opts))) 36 | (def t2 (assoc t1 3 -3)) 37 | (println t2) 38 | (def t3 (assoc t2 3 2)) 39 | (println t3) 40 | (def t4 (assoc t3 -2 2)) 41 | (println t4 (count t4)) 42 | 43 | (def t8 (-> {} 44 | (assoc (clojure.core/with-meta [0] {:foo 0}) (clojure.core/with-meta [0] {:foo 0})) 45 | (assoc (clojure.core/with-meta [0] {:foo 0}) (clojure.core/with-meta [0] {:foo nil})))) 46 | (println t8) 47 | (println (meta (first (seq (keys t8))))) 48 | (println (meta (first (seq (vals t8))))) 49 | 50 | (def t9 (-> (new-sorted-map (basic-opts)) 51 | (assoc (clojure.core/with-meta [0] {:foo 0}) (clojure.core/with-meta [0] {:foo 0})) 52 | (assoc (clojure.core/with-meta [0] {:foo 0}) (clojure.core/with-meta [0] {:foo nil})))) 53 | (println t9) 54 | (println (meta (first (seq (keys t9))))) 55 | (println (meta (first (seq (vals t9))))) 56 | 57 | (println) 58 | (println (nth x123 -1 nil)) 59 | (println (nth x123 0 nil)) 60 | (println (nth x123 1 nil)) 61 | (println (nth x123 2 nil)) 62 | (println (nth x123 3 nil)) 63 | 64 | (println) 65 | (def y (new-vector (lazy-opts))) 66 | (println (count y)) 67 | (def y1 (conj y 1001)) 68 | (println (count y1)) 69 | (def y12 (addn y1 1 1002)) 70 | (println (count y12)) 71 | (def y012 (addn y12 0 1000)) 72 | (println (count y012)) 73 | (println y012) 74 | (println (pop y012)) 75 | (println (pop (pop y012))) 76 | (println (pop (pop (pop y012)))) 77 | (println (addn (conj y 0) 0 0)) 78 | (println (dropn y012 0)) 79 | (println (dropn y012 1)) 80 | (println (dropn y012 1 1)) 81 | (println (dropn y012 3)) 82 | 83 | (println (conj (new-vector (lazy-opts)) 0)) 84 | 85 | (println "pr-str y" (pr-str y)) 86 | (println "y length" (byte-length y)) 87 | (println "pr-str y1" (pr-str y1)) 88 | (println "y1 length" (byte-length y1)) 89 | (println "pr-str y12" (pr-str y12)) 90 | (println "y12 length" (byte-length y12)) 91 | (println "pr-str y012" (pr-str y012)) 92 | (println "y012 length" (byte-length y012)) 93 | 94 | (def bb (ByteBuffer/allocate (byte-length y012))) 95 | (put-aa bb y012) 96 | (println "y012 length" (byte-length y012)) 97 | (println "y" y) 98 | (.flip bb) 99 | (def Y (load-vector bb (lazy-opts))) 100 | (println "loaded aavector" (byte-length Y)) 101 | (println Y) 102 | 103 | (println) 104 | (def elm (new-sorted-map (lazy-opts))) 105 | (println elm) 106 | (println "map len" (byte-length elm)) 107 | (def elmb (ByteBuffer/allocate (byte-length elm))) 108 | (put-aa elmb elm) 109 | (.flip elmb) 110 | (def ELM (load-sorted-map elmb (lazy-opts))) 111 | (println "loaded empty lazy map" (byte-length ELM)) 112 | (println ELM) 113 | (def elm1 (assoc elm 1001 1)) 114 | (println (type elm1)) 115 | (println elm1) 116 | (println "map len" (byte-length elm1)) 117 | (def elm1b (ByteBuffer/allocate (byte-length elm1))) 118 | (put-aa elm1b elm1) 119 | (.flip elm1b) 120 | (def ELM1 (load-sorted-map elm1b (lazy-opts))) 121 | (println "loaded lazy map" (byte-length ELM1)) 122 | (println ELM1) 123 | (def elm12 (assoc elm1 1002 2)) 124 | (println (type elm12)) 125 | (println elm12) 126 | (println "map len" (byte-length elm12)) 127 | (def elm12b (ByteBuffer/allocate (byte-length elm12))) 128 | (put-aa elm12b elm12) 129 | (.flip elm12b) 130 | (def ELM12 (load-sorted-map elm12b (lazy-opts))) 131 | (println "loaded lazy map" (byte-length ELM12)) 132 | (println ELM12) 133 | 134 | (def gen-element 135 | (gen/tuple gen/int)) 136 | 137 | (deftest vec-tests 138 | ; (assert-vector-like 100 (new-vector (basic-opts)) gen-element)) 139 | (assert-vector-like 1 (new-vector (basic-opts)) gen-element)) 140 | 141 | (deftest lazy-vec-tests 142 | ; (assert-vector-like 100 (new-vector (lazy-opts)) gen-element)) 143 | (assert-vector-like 1 (new-vector (lazy-opts)) gen-element)) 144 | 145 | (deftest map-tests 146 | ; (assert-map-like 100 147 | (assert-map-like 1 148 | (new-sorted-map (basic-opts)) 149 | gen-element gen-element 150 | {:base (sorted-map) :ordered? true})) 151 | 152 | (deftest lazy-map-tests 153 | ; (assert-map-like 100 154 | (assert-map-like 1 155 | (new-sorted-map (lazy-opts)) 156 | gen-element gen-element 157 | {:base (sorted-map) :ordered? true})) 158 | 159 | (deftest set-tests 160 | ; (assert-set-like 100 161 | (assert-set-like 1 162 | (new-sorted-set (basic-opts)) 163 | gen-element 164 | {:base (sorted-set) :ordered? true})) 165 | 166 | (deftest lazy-set-tests 167 | ; (assert-set-like 100 168 | (assert-set-like 1 169 | (new-sorted-set (lazy-opts)) 170 | gen-element 171 | {:base (sorted-set) :ordered? true})) 172 | 173 | (deftest nth-of-set 174 | (is (= :not-found (nth (conj (new-sorted-set (basic-opts)) 1 2 3) 4 :not-found)))) -------------------------------------------------------------------------------- /test/aatree/cs256_example.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.cs256-example 2 | (:require [aatree.core :refer :all] 3 | [aatree.nodes :refer :all]) 4 | (:import (java.nio ByteBuffer) 5 | (java.io File))) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | (def opts (lazy-opts)) 10 | (def empty-set (new-sorted-set opts)) 11 | 12 | (let [ls1 (conj empty-set :dog :cat :rabbit) 13 | bb-len (+ (byte-length ls1) 32) 14 | ^ByteBuffer bb (ByteBuffer/allocate bb-len) 15 | _ (put-aa bb ls1) 16 | ^ByteBuffer csbb (.flip (.duplicate bb)) 17 | cs (compute-cs256 csbb)] 18 | (put-cs256 bb cs) 19 | (.flip bb) 20 | (file-save bb (File. "cs245-example.lazy"))) 21 | 22 | (let [^ByteBuffer bb (file-load (File. "cs245-example.lazy")) 23 | csp (- (.limit bb) 32) 24 | ^ByteBuffer csbb (.limit (.duplicate bb) csp) 25 | cs (compute-cs256 csbb) 26 | ocs (get-cs256 (.position (.duplicate bb) csp)) 27 | lv2 (if (= cs ocs) 28 | (load-sorted-set bb opts) 29 | (throw (java.lang.Exception. "Checksum does not match")))] 30 | (println lv2)); -> #{:cat :dog :rabbit} 31 | -------------------------------------------------------------------------------- /test/aatree/db_chan_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.db-chan-test 2 | (:require [clojure.test :refer :all] 3 | [aatree.core :refer :all] 4 | [aatree.db-chan-trait :refer :all] 5 | [aatree.closer-trait :refer :all])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | (deftest chan-trait 10 | (try 11 | (println "#######################") 12 | (let [db (-> {:db-updater 13 | (fn [this app-updater] 14 | (app-updater this))} 15 | (db-chan) 16 | (create-db-chan {}))] 17 | (db-send db (fn [_] (println ":-)"))) 18 | (db-send db (fn [_] (println ":D"))) 19 | (println (db-update db (fn [_] (println ";-}")))) 20 | (let [db (assoc db :send-update-timeout 300)] 21 | (println (db-update db (fn [_] (Thread/sleep 1000)))) 22 | (println (db-update db (fn [_] (Thread/sleep 1000)))) 23 | (println (db-update db (fn [_] (throw (Exception. "fun"))))) 24 | (Thread/sleep 200) 25 | (close-components db))) 26 | (finally 27 | (println "done")))) -------------------------------------------------------------------------------- /test/aatree/file_example.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.file-example 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer) 4 | (java.io File))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | (def opts (lazy-opts)) 9 | (def empty-map (new-sorted-map opts)) 10 | 11 | (let [bm1 (conj empty-map {:dog "Jack" :cat "Sammy" :rabbit "Henry"}) 12 | bm1-len (byte-length bm1) 13 | ^ByteBuffer bb (ByteBuffer/allocate bm1-len)] 14 | (put-aa bb bm1) 15 | (.flip bb) 16 | (file-save bb (File. "file-example.lazy"))) 17 | 18 | (let [^ByteBuffer bb (file-load (File. "file-example.lazy")) 19 | bm2 (load-sorted-map bb opts)] 20 | (println bm2)); -> {:cat Sammy, :dog Jack, :rabbit Henry} 21 | -------------------------------------------------------------------------------- /test/aatree/lazy_map_benchmark.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lazy-map-benchmark 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;(def map-size 1000000) 8 | (def map-size 1) 9 | ;(def updates 1000) 10 | (def updates 1) 11 | 12 | (defn bld [m i] 13 | (conj m [i i])) 14 | 15 | (println) 16 | (def t0 (System/currentTimeMillis)) 17 | (def lazy-map (reduce bld (new-sorted-map (lazy-opts)) (range map-size))) 18 | (def t1 (System/currentTimeMillis)) 19 | (def micr-0 (* 1000. (- t1 t0))) 20 | (println "Time to build a lazy sorted map of size" map-size "=" micr-0 "microseconds") 21 | (println "Time per entry:" (/ micr-0 map-size) "microseconds") 22 | 23 | (defn upd [m i] 24 | (let [m1 (assoc m i (- i)) 25 | bb (ByteBuffer/allocate (byte-length m1))] 26 | (put-aa bb m1) 27 | (.flip bb) 28 | (load-sorted-map bb (lazy-opts)))) 29 | 30 | (println) 31 | (def t0 (System/currentTimeMillis)) 32 | (def lazy-m (reduce upd lazy-map (range updates))) 33 | (def t1 (System/currentTimeMillis)) 34 | (def micr-0 (* 1000. (- t1 t0))) 35 | (println "Time to deserialize/update/reserialize " updates "times =" micr-0 "microseconds") 36 | (println "Time per complete update:" (/ micr-0 updates) "microseconds") 37 | 38 | (println) -------------------------------------------------------------------------------- /test/aatree/lazy_sorted_map_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lazy-sorted-map-examples 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | (def opts (lazy-opts)) 8 | 9 | (def empty-set (new-sorted-set opts)) 10 | (def empty-map (new-sorted-map opts)) 11 | (def empty-vec (new-vector opts)) 12 | 13 | (println (byte-length empty-map)); -> 1 14 | 15 | (def lm1 (conj empty-map {:dog "Jack" :cat "Sammy" :rabbit "Henry"})) 16 | (println lm1); -> {:cat Sammy, :dog Jack, :rabbit Henry} 17 | 18 | (def lm1-len (byte-length lm1)) 19 | (println lm1-len); -> 143 20 | 21 | (def ^ByteBuffer bb (ByteBuffer/allocate lm1-len)) 22 | (put-aa bb lm1) 23 | (.flip bb) 24 | (def lm2 (load-sorted-map bb opts)) 25 | (println lm2); -> {:cat Sammy, :dog Jack, :rabbit Henry} 26 | 27 | (def lv1 (conj empty-vec 1 2 3)) 28 | (def lm3 (conj lm2 [:vct lv1])) 29 | (println lm3); -> {:cat Sammy, :dog Jack, :vct [1 2 3], :rabbit Henry} 30 | 31 | (def lm3-len (byte-length lm3)) 32 | (println lm3-len); -> 230 33 | 34 | (def ^ByteBuffer bb (ByteBuffer/allocate lm3-len)) 35 | (put-aa bb lm3) 36 | (.flip bb) 37 | (def lm4 (load-sorted-map bb opts)) 38 | (println lm4); -> {:cat Sammy, :dog Jack, :vct [1 2 3], :rabbit Henry} 39 | 40 | (def lm5 (conj empty-map {"b" :bandana "h" :hat})) 41 | (def lm6 (conj lm4 [:map lm5])) 42 | (println lm6); -> {:cat Sammy, :dog Jack, :vct [1 2 3], :map {b :bandana, h :hat}, :rabbit Henry} 43 | 44 | (def lm6-len (byte-length lm6)) 45 | (println lm6-len); -> 341 46 | 47 | (def ^ByteBuffer bb (ByteBuffer/allocate lm6-len)) 48 | (put-aa bb lm6) 49 | (.flip bb) 50 | (def lm7 (load-sorted-map bb opts)) 51 | (println lm7); -> {:cat Sammy, :dog Jack, :vct [1 2 3], :map {b :bandana, h :hat}, :rabbit Henry} 52 | 53 | (def ls1 (conj empty-set "a" "c" "b")) 54 | (def lm8 (conj lm7 [:set ls1])) 55 | (println lm8); -> {:cat Sammy, :dog Jack, :map {b :bandana, h :hat}, :rabbit Henry, :set #{a b c}, :vct [1 2 3]} 56 | 57 | (def lm8-len (byte-length lm8)) 58 | (println lm8-len); -> 440 59 | 60 | (def ^ByteBuffer bb (ByteBuffer/allocate lm8-len)) 61 | (put-aa bb lm8) 62 | (.flip bb) 63 | (def lm9 (load-sorted-map bb opts)) 64 | (println lm9); -> {:cat Sammy, :dog Jack, :map {b :bandana, h :hat}, :rabbit Henry, :set #{a b c}, :vct [1 2 3]} 65 | -------------------------------------------------------------------------------- /test/aatree/lazy_sorted_set_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lazy-sorted-set-examples 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | (def opts (lazy-opts)) 8 | 9 | (def empty-set (new-sorted-set opts)) 10 | (println (byte-length empty-set)); -> 1 11 | 12 | (def ls1 (conj empty-set :dog :cat :rabbit)) 13 | (println ls1); -> #{:cat :dog :rabbit} 14 | 15 | (def ls1-len (byte-length ls1)) 16 | (println ls1-len); -> 85 17 | 18 | (def ^ByteBuffer bb (ByteBuffer/allocate ls1-len)) 19 | (put-aa bb ls1) 20 | (.flip bb) 21 | (def ls2 (load-sorted-set bb opts)) 22 | (println ls2); -> #{:cat :dog :rabbit} 23 | -------------------------------------------------------------------------------- /test/aatree/lazy_vector_benchmark.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lazy-vector-benchmark 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;(def vector-size 1000000) 8 | (def vector-size 1) 9 | ;(def updates 1000) 10 | (def updates 1) 11 | 12 | (println) 13 | (def t0 (System/currentTimeMillis)) 14 | (def lazy-vector (reduce conj (new-vector (lazy-opts)) (range vector-size))) 15 | (def t1 (System/currentTimeMillis)) 16 | (def micr-0 (* 1000. (- t1 t0))) 17 | (println "Time to build a lazy vector of size" vector-size "=" micr-0 "microseconds") 18 | (println "Time per entry:" (/ micr-0 vector-size) "microseconds") 19 | 20 | (defn upd [v i] 21 | (let [v1 (assoc v i (- i)) 22 | bb (ByteBuffer/allocate (byte-length v1))] 23 | (put-aa bb v1) 24 | (.flip bb) 25 | (load-vector bb (lazy-opts)))) 26 | 27 | (println) 28 | (def t0 (System/currentTimeMillis)) 29 | (def lazy-vector (reduce upd lazy-vector (range updates))) 30 | (def t1 (System/currentTimeMillis)) 31 | (def micr-0 (* 1000. (- t1 t0))) 32 | (println "Time to deserialize/update/reserialize " updates "times =" micr-0 "microseconds") 33 | (println "Time per complete update:" (/ micr-0 updates) "microseconds") 34 | 35 | (println) -------------------------------------------------------------------------------- /test/aatree/lazy_vector_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.lazy-vector-examples 2 | (:require [aatree.core :refer :all]) 3 | (:import (java.nio ByteBuffer))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | (def opts (lazy-opts)) 8 | 9 | (def empty-set (new-sorted-set opts)) 10 | (def empty-map (new-sorted-map opts)) 11 | (def empty-vec (new-vector opts)) 12 | 13 | (println (byte-length empty-vec)); -> 1 14 | 15 | (def lv1 (conj empty-vec 1 2 3)) 16 | (println lv1); -> [1 2 3] 17 | 18 | (def lv1-len (byte-length lv1)) 19 | (println lv1-len); -> 61 20 | 21 | (def ^ByteBuffer bb (ByteBuffer/allocate lv1-len)) 22 | (put-aa bb lv1) 23 | (.flip bb) 24 | (def lv2 (load-vector bb opts)) 25 | (println lv2); -> [1 2 3] 26 | 27 | (def lv3 (conj empty-vec lv1)) 28 | (println lv3); -> [[1 2 3]] 29 | 30 | (def lv3-len (byte-length lv3)) 31 | (println lv3-len); -> 76 32 | 33 | (def ^ByteBuffer bb (ByteBuffer/allocate lv3-len)) 34 | (put-aa bb lv3) 35 | (.flip bb) 36 | (def lv4 (load-vector bb opts)) 37 | (println lv4); -> [[1 2 3]] 38 | 39 | (def lv5 (lv4 0)) 40 | (println lv5); -> [1 2 3] 41 | (println (class lv5)); -> aatree.AAVector 42 | 43 | (def lm1 (conj empty-map {:dog "Jack" :cat "Sammy" :rabbit "Henry"})) 44 | (def lv6 (conj lv4 lm1)) 45 | (println lv6); -> [[1 2 3] {:cat Sammy, :dog Jack, :rabbit Henry}] 46 | 47 | (def lv6-len (byte-length lv6)) 48 | (println lv6-len); -> 233 49 | 50 | (def ^ByteBuffer bb (ByteBuffer/allocate lv6-len)) 51 | (put-aa bb lv6) 52 | (.flip bb) 53 | (def lv7 (load-vector bb opts)) 54 | (println lv7); -> [[1 2 3] {:cat Sammy, :dog Jack, :rabbit Henry}] 55 | 56 | (def lm2 (lv7 1)) 57 | (println lm2); -> {:cat Sammy, :dog Jack, :rabbit Henry} 58 | (println (class lm2)); -> aatree.AAMap 59 | 60 | (def ls1 (conj empty-set :dog :cat :rabbit)) 61 | (def lv8 (conj lv7 ls1)) 62 | (println lv8); -> [[1 2 3] {:cat Sammy, :dog Jack, :rabbit Henry} 63 | ; #{:cat :dog :rabbit}] 64 | 65 | (def lv8-len (byte-length lv8)) 66 | (println lv8-len); -> 332 67 | 68 | (def ^ByteBuffer bb (ByteBuffer/allocate lv8-len)) 69 | (put-aa bb lv8) 70 | (.flip bb) 71 | (def lv9 (load-vector bb opts)) 72 | (println lv9); -> [[1 2 3] {:cat Sammy, :dog Jack, :rabbit Henry} 73 | ; #{:cat :dog :rabbit}] 74 | 75 | (def ls2 (lv9 2)) 76 | (println ls2); -> #{:cat :dog :rabbit} 77 | (println (class ls2)); -> aatree.AASet 78 | -------------------------------------------------------------------------------- /test/aatree/log4j_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.log4j-test 2 | (:require [clojure.tools.logging :as log])) 3 | 4 | (log/info "? :-) <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<") 5 | -------------------------------------------------------------------------------- /test/aatree/nodes_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.nodes-test 2 | (:require [clojure.test :refer :all] 3 | [aatree.nodes :refer :all]) 4 | (:import (clojure.lang MapEntry RT))) 5 | 6 | (def v0 emptyNode) 7 | (pnodev v0 "v0" {}) 8 | 9 | (def v1 (vector-add v0 1001 0 {})) 10 | (pnodev v1 "v1" {}) 11 | 12 | (def v01 (vector-add v1 1000 0 {})) 13 | (pnodev v01 "v01" {}) 14 | 15 | (def v012 (vector-add v01 1002 2 {})) 16 | (pnodev v012 "v012" {}) 17 | 18 | (pnodev (deln v012 0 {}) "v012 - 0" {}) 19 | 20 | (pnodev (deln v012 1 {}) "v012 - 1" {}) 21 | 22 | (pnodev (deln v012 2 {}) "v012 - 2" {}) 23 | 24 | (def m0 emptyNode) 25 | 26 | (def m1 (map-insert m0 (new MapEntry "1" 1001) {:comparator RT/DEFAULT_COMPARATOR})) 27 | (pnodev m1 "m1" {}) 28 | (pnodev (map-del m1 "1" {:comparator RT/DEFAULT_COMPARATOR}) "m1 - 1" {}) 29 | 30 | (def m13 (map-insert m1 (new MapEntry "3" 1003) {:comparator RT/DEFAULT_COMPARATOR})) 31 | (pnodev m13 "m13" {}) 32 | (println "m13 level" (.level m13)) 33 | (pnodev (map-del m13 "1" {:comparator RT/DEFAULT_COMPARATOR}) "m13 - 1" {}) 34 | (pnodev (map-del (map-del m13 "1" {:comparator RT/DEFAULT_COMPARATOR}) "3" {:comparator RT/DEFAULT_COMPARATOR}) 35 | "m13 - -" 36 | {}) 37 | (def m123 (map-insert m13 (new MapEntry "2" 1002) {:comparator RT/DEFAULT_COMPARATOR})) 38 | (pnodev m123 "m123" {}) 39 | (pnodev (map-del m123 "1" {:comparator RT/DEFAULT_COMPARATOR}) "m123 - 1" {}) 40 | (pnodev (map-del m123 "2" {:comparator RT/DEFAULT_COMPARATOR}) "m123 - 2" {}) 41 | (pnodev (map-del m123 "3" {:comparator RT/DEFAULT_COMPARATOR}) "m123 - 3" {}) 42 | (pnodev (map-insert m123 (new MapEntry "1" 1001) {:comparator RT/DEFAULT_COMPARATOR}) "m123 + 1" {}) 43 | (pnodev (map-insert m123 (new MapEntry "1" 1010) {:comparator RT/DEFAULT_COMPARATOR}) "m123 + 1" {}) 44 | 45 | (println (new-counted-seq m0 {})) 46 | (println (new-counted-seq m1 {})) 47 | (println (new-counted-seq m13 {})) 48 | (println (new-counted-seq m123 {})) 49 | (println (new-counted-reverse-seq m123 {})) 50 | (println (new-map-key-seq m123 {})) 51 | (println (new-map-key-reverse-seq m123 {})) 52 | (println (new-map-value-seq m123 {})) 53 | (println (new-map-value-reverse-seq m123 {})) 54 | 55 | (println "") 56 | (def mi (new-counted-iterator m123 {})) 57 | (println (.hasNext mi)) 58 | (println (.next mi)) 59 | (println (.hasNext mi)) 60 | (println (.next mi)) 61 | (println (.hasNext mi)) 62 | (println (.next mi)) 63 | (println (.hasNext mi)) 64 | (println (map-index-of m123 "0" {:comparator RT/DEFAULT_COMPARATOR})) 65 | (println (map-index-of m123 "1" {:comparator RT/DEFAULT_COMPARATOR})) 66 | (println (map-index-of m123 "2" {:comparator RT/DEFAULT_COMPARATOR})) 67 | (println (map-index-of m123 "3" {:comparator RT/DEFAULT_COMPARATOR})) 68 | (println (map-index-of m123 "4" {:comparator RT/DEFAULT_COMPARATOR})) 69 | (println (nth-t2 m123 0 {})) 70 | (println (nth-t2 m123 1 {})) 71 | (println (nth-t2 m123 2 {})) 72 | 73 | -------------------------------------------------------------------------------- /test/aatree/record_play.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.record-play 2 | (:require [aatree.record-play0 :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (defprotocol gran 7 | (blip [this x y z]) 8 | (blap [this])) 9 | 10 | (def w (-> {} new-base new-wackel)) 11 | 12 | (extend-type aatree.record_play0.wackel 13 | gran 14 | (blip [this x y z] 15 | ((:blip this) this x y z)) 16 | (blap [this] 17 | ((:blap this) this))) 18 | 19 | (def w (-> {} new-base new-wackel)) 20 | 21 | (println (blip w 1 2 3)) ; -> 6 22 | 23 | (println (blap w)) ; -> 42 24 | -------------------------------------------------------------------------------- /test/aatree/record_play0.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.record-play0) 2 | 3 | (set! *warn-on-reflection* true) 4 | 5 | (defrecord base []) 6 | 7 | (defn new-base [opts] 8 | (-> (->base) 9 | (into opts) 10 | (assoc :blap (fn [this] 42)))) 11 | 12 | (defrecord wackel []) 13 | 14 | (defn new-wackel [opts] 15 | (-> (->wackel) 16 | (into opts) 17 | (assoc :blip (fn [this x y z] (+ x y z))))) 18 | -------------------------------------------------------------------------------- /test/aatree/standard_sorted_map_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.standard-sorted-map-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (def opts (standard-opts)) 7 | 8 | (def bm1 (conj (new-sorted-map opts) {:dog "Jack" :cat "Sammy" :rabbit "Henry"})) 9 | (println bm1); -> {:cat Sammy, :dog Jack, :rabbit Henry} 10 | 11 | (println (rseq bm1)); -> ([:rabbit Henry] [:dog Jack] [:cat Sammy]) 12 | -------------------------------------------------------------------------------- /test/aatree/standard_sorted_set_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.standard-sorted-set-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (def opts (standard-opts)) 7 | 8 | (def bs1 (conj (new-sorted-set opts) :dog :cat :rabbit)) 9 | (println bs1); -> #{:cat :dog :rabbit} 10 | 11 | (println (rseq bs1)); -> (:rabbit :dog :cat) 12 | -------------------------------------------------------------------------------- /test/aatree/standard_vector_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.standard-vector-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (def opts (standard-opts)) 7 | 8 | (def bv1 (conj (new-vector opts) 1 2 3)) 9 | (println bv1); -> [1 2 3] 10 | 11 | (def s1 (seq bv1)) 12 | (println s1); -> (1 2 3) 13 | (println (count s1)); -> 3 14 | 15 | (def s2 (next s1)) 16 | (println s2); -> (2 3) 17 | (println (count s2)); -> 2 18 | 19 | (println (rseq bv1)); -> (3 2 1) 20 | 21 | -------------------------------------------------------------------------------- /test/aatree/transcribe_examples.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.transcribe-examples 2 | (:require [aatree.core :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | ; The recognized classes 7 | (println (class [])) 8 | ; -> clojure.lang.PersistentVector 9 | (println (class (new-vector (standard-opts)))) 10 | ; -> clojure.lang.PersistentVector 11 | (println (class (new-vector (basic-opts)))) 12 | ; -> aatree.AAVector 13 | (println (class (sorted-map))) 14 | ; -> clojure.lang.PersistentTreeMap 15 | (println (class (new-sorted-map (standard-opts)))) 16 | ; -> clojure.lang.PersistentTreeMap 17 | (println (class (new-sorted-map (basic-opts)))) 18 | ; -> clojure.lang.aatree.AAMap 19 | (println (class (sorted-set))) 20 | ; -> clojure.lang.PersistentTreeSet 21 | (println (class (new-sorted-set (standard-opts)))) 22 | ; -> clojure.lang.PersistentTreeSet 23 | (println (class (new-sorted-set (basic-opts)))) 24 | ; -> clojure.lang.aatree.AASet 25 | (println) 26 | 27 | ; Top-level conversion 28 | (println (class (transcribe [] (basic-opts)))) 29 | ; -> aatree.AAVector 30 | (println (class (transcribe (transcribe [] (basic-opts)) 31 | (standard-opts)))) 32 | ; -> clojure.lang.PersistentVector 33 | (println (class (transcribe (sorted-map) (basic-opts)))) 34 | ; -> clojure.lang.aatree.AAMap 35 | (println (class (transcribe (transcribe (sorted-map) (basic-opts)) 36 | (standard-opts)))) 37 | ; -> clojure.lang.PersistentTreeMap 38 | (println (class (transcribe (sorted-set) (basic-opts)))) 39 | ; -> clojure.lang.aatree.AASet 40 | (println (class (transcribe (transcribe (sorted-set) (basic-opts)) 41 | (standard-opts)))) 42 | ; -> clojure.lang.PersistentTreeSet 43 | (println) 44 | 45 | ; No conversion of unrecognized structures 46 | (println (class (list))) 47 | ; -> clojure.lang.PersistentList$EmptyList 48 | (println (class (transcribe (list) (basic-opts)))) 49 | ; -> clojure.lang.PersistentList$EmptyList 50 | (println) 51 | 52 | ; recursive conversion of recognized structures 53 | (def std-vec [[]]) 54 | (def basic-vec (transcribe std-vec (basic-opts))) 55 | (println (class (basic-vec 0))) 56 | ; -> aatree.AAVector 57 | (println (class (transcribe basic-vec (standard-opts)))) 58 | ; -> clojure.lang.PersistentVector 59 | (def std-map (conj (sorted-map) [:m {}])) 60 | (def basic-map (transcribe std-map (basic-opts))) 61 | (println (class (basic-map :m))) 62 | ; -> aatree.AAMap 63 | (println (class (transcribe basic-map (standard-opts)))) 64 | ; -> clojure.lang.PersistentTreeMap 65 | -------------------------------------------------------------------------------- /test/aatree/transparent_transcription_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.transparent-transcription-test 2 | (:require [clojure.test :refer :all] 3 | [aatree.core :refer :all] 4 | [aatree.yearling :refer :all] 5 | [aatree.closer-trait :refer :all]) 6 | (:import (java.io File))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (deftest transparent-transcription 11 | (let [file-a (File. "transcription-a.yearling") 12 | file-b (File. "transcription-b.yearling") 13 | _ (.delete file-a) 14 | _ (.delete file-b) 15 | yearling-a (yearling-open file-a) 16 | yearling-b (yearling-open file-b) 17 | _ (db-update yearling-a 18 | (fn [db] 19 | (update-assoc-in! db [:app-map :v] [1 2 3]))) 20 | va (db-get-in yearling-a [:app-map :v]) 21 | _ (is (= "aatree.AAVector" (.getName (class va)))) 22 | va-opts (aa-opts va) 23 | ^File va-file (:db-file va-opts) 24 | va-file-name (.toString va-file) 25 | _ (is (= va-file-name (.toString file-a))) 26 | _ (db-update yearling-b 27 | (fn [db] 28 | (update-assoc-in! db [:app-map :v] va))) 29 | vb (db-get-in yearling-b [:app-map :v]) 30 | _ (is (= "aatree.AAVector" (.getName (class vb)))) 31 | vb-opts (aa-opts vb) 32 | ^File vb-file (:db-file vb-opts) 33 | vb-file-name (.toString vb-file) 34 | _ (is (= vb-file-name (.toString file-b))) 35 | _ (close-components yearling-a) 36 | _ (close-components yearling-b) 37 | ]) 38 | 39 | (Thread/sleep 200)) 40 | -------------------------------------------------------------------------------- /test/aatree/unique_timestamp_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.unique-timestamp-test 2 | (:require [aatree.unique-timestamp :refer :all])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | (if (= (new-timestamp) (new-timestamp)) 7 | (throw (Exception. "timestamps equal!"))) 8 | 9 | (time (reduce (fn [_ _] (new-timestamp)) 10 | nil 11 | (range 10240))) ; Must take more than 10 millis! 12 | ; -> "Elapsed time: 12.593512 msecs" 13 | -------------------------------------------------------------------------------- /test/aatree/virtual_benchmark.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.virtual-benchmark 2 | (:require [clojure.test :refer :all] 3 | [aatree.core :refer :all] 4 | [aatree.yearling :refer :all] 5 | [aatree.closer-trait :refer :all]) 6 | (:import (java.io File))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (deftest virtual 11 | (.delete (File. "virtual-benchmark.yearling")) 12 | 13 | (let [yearling (yearling-open (File. "virtual-benchmark.yearling")) 14 | ;mxi 100000 15 | mxi 2000 16 | mxj 5 17 | mxk 2] 18 | (time 19 | (reduce 20 | (fn [_ k] 21 | (reduce 22 | (fn [_ j] 23 | (db-update 24 | yearling 25 | (fn [db] 26 | (let [aamap (update-get-in db [:app-map]) 27 | bbmap (reduce (fn [m i] 28 | (assoc m (+ i (* mxi j) (* mxi mxj k)) 1)) 29 | aamap 30 | (range mxi))] 31 | (update-assoc-in! db [:app-map] bbmap))))) 32 | nil 33 | (range mxj))) 34 | nil 35 | (range mxk))) ; -> "Elapsed time: 39369.950654 msecs" 36 | (println "count" (count (db-get-in yearling [:app-map]))) 37 | (let [app-map (db-get-in yearling [:app-map])] 38 | (time (reduce 39 | (fn [_ i] (get app-map i)) 40 | nil 41 | (range (count (db-get-in yearling [:app-map])))))) ; -> "Elapsed time: 8404.581527 msecs" 42 | (close-components yearling)) 43 | 44 | (Thread/sleep 200)) 45 | -------------------------------------------------------------------------------- /test/aatree/yearling_test.clj: -------------------------------------------------------------------------------- 1 | (ns aatree.yearling-test 2 | (:require [clojure.test :refer :all] 3 | [aatree.core :refer :all] 4 | [aatree.yearling :refer :all] 5 | [aatree.closer-trait :refer :all]) 6 | (:import (java.io File))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (deftest yearling 11 | (.delete (File. "yearling-test.yearling")) 12 | 13 | (let [yearling {:max-db-size 100000 14 | :db-block-size 10000} 15 | yearling (yearling-open yearling (File. "yearling-test.yearling")) 16 | app-map (db-get-in yearling [:app-map]) 17 | _ (is (= (get-transaction-count yearling) 2)) 18 | _ (is (= app-map nil)) 19 | _ (is (= (db-allocated yearling) 2)) 20 | _ (db-update 21 | yearling 22 | (fn [db] 23 | (update-assoc-in! db [:app-map :block] (db-allocate db)))) 24 | block (db-get-in yearling [:app-map :block]) 25 | _ (is (= (get-transaction-count yearling) 3)) 26 | _ (is (= block 2)) 27 | _ (is (= (db-allocated yearling) 3)) 28 | _ (is (= (count (db-get-in yearling [:release-pending])) 0)) 29 | _ (db-update 30 | yearling 31 | (fn [db] 32 | (println "new node id" (db-new-node-id db)) 33 | (db-release db block) 34 | (update-dissoc-in! db [:app-map :block]))) 35 | app-map (db-get-in yearling [:app-map]) 36 | _ (is (= (get-transaction-count yearling) 4)) 37 | _ (is (= app-map nil)) 38 | _ (is (= (db-allocated yearling) 3)) 39 | _ (is (= (count (db-get-in yearling [:release-pending])) 1)) 40 | _ (close-components yearling)]) 41 | 42 | (let [yearling {:db-pending-count 99 43 | :max-db-size 100000 44 | :db-block-size 10000} 45 | yearling (yearling-open yearling (File. "yearling-test.yearling")) 46 | app-map (db-get-in yearling [:app-map]) 47 | _ (is (= (get-transaction-count yearling) 4)) 48 | _ (is (= app-map nil)) 49 | _ (is (= (db-allocated yearling) 3)) 50 | _ (is (= (count (db-get-in yearling [:release-pending])) 1)) 51 | _ (db-update 52 | yearling 53 | (fn [db] 54 | (println "new node id" (db-new-node-id db)) 55 | (db-process-pending db 0 1))) 56 | app-map (db-get-in yearling [:app-map]) 57 | _ (is (= (get-transaction-count yearling) 5)) 58 | _ (is (= app-map nil)) 59 | _ (is (= (db-allocated yearling) 2)) 60 | _ (is (= (count (db-get-in yearling [:release-pending])) 0)) 61 | _ (close-components yearling)]) 62 | 63 | (Thread/sleep 200)) 64 | --------------------------------------------------------------------------------