├── project.clj ├── resources ├── mapSolarSystemJumps.csv └── mapSolarSystems.csv └── src └── build_your_own_logic_engine └── core.clj /project.clj: -------------------------------------------------------------------------------- 1 | (defproject build-your-own-logic-engine "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.10.0-RC1"] 7 | [org.clojure/data.csv "0.1.4"]]) 8 | -------------------------------------------------------------------------------- /src/build_your_own_logic_engine/core.clj: -------------------------------------------------------------------------------- 1 | (ns build-your-own-logic-engine.core 2 | (:refer-clojure :exclude [==]) 3 | (:require [clojure.java.io :as io] 4 | [clojure.data.csv :as csv] 5 | [clojure.edn :as edn] 6 | [clojure.string :as str] 7 | [clojure.pprint :refer [pprint]] 8 | [clojure.set :as set]) 9 | (:import (java.io Writer) 10 | (clojure.lang IDeref))) 11 | 12 | ;; Paper that describes the basic concepts we'll be using today 13 | ;; http://webyrd.net/scheme-2013/papers/HemannMuKanren2013.pdf 14 | 15 | ;; We are building a interpreter of sorts, so the first thing we need to do is 16 | ;; define what we're going to use for "locals" and how they are stored. We will call 17 | ;; these locals "logic variables" or "lvars" for short. 18 | 19 | (defn lvar 20 | ([] 21 | (gensym)) 22 | ([prefix] 23 | (gensym prefix))) 24 | 25 | (defn lvar? 26 | "Is this a lvar?" 27 | [v] 28 | (symbol? v)) 29 | 30 | (defn walk [env v] 31 | (if-let [[_ nv] (find env v)] 32 | (recur env nv) 33 | v)) 34 | 35 | (defn grounded? 36 | "Is this value not a lvar?, and optionally takes an environment." 37 | ([v] 38 | (not (lvar? v))) 39 | ([env v] 40 | (not (lvar? (walk env v))))) 41 | 42 | (comment 43 | 44 | (lvar) 45 | (lvar "foo") 46 | 47 | (let [a (lvar "a")] 48 | (walk {a 1} a)) 49 | 50 | (let [a (lvar "a") 51 | b (lvar "b")] 52 | (walk {a 1} b)) 53 | 54 | (let [a (lvar "a") 55 | b (lvar "b")] 56 | (walk {a 1 b a} b)) 57 | 58 | 59 | (let [a (lvar "a")] 60 | (lvar? (walk {a 1} a))) 61 | 62 | (let [a (lvar "a")] 63 | (grounded? (walk {a 1} a))) 64 | 65 | (let [a (lvar "a")] 66 | (grounded? {a 1} a)) 67 | 68 | ) 69 | 70 | ;; The next main primitive we need is "unify" or the process of checking if two lvars 71 | ;; can be equal given an environment. 72 | 73 | (defn unify [env a b] 74 | (let [a' (walk env a) 75 | b' (walk env b)] 76 | (cond 77 | (nil? env) env 78 | 79 | (and (lvar? a') 80 | (lvar? b')) (assoc env a' b') 81 | 82 | (lvar? a') (assoc env a' b') 83 | (lvar? b') (assoc env b' a') 84 | 85 | :else 86 | (when (= a' b') env)))) 87 | 88 | (comment 89 | (unify {} 1 2) 90 | (unify {} 1 1) 91 | 92 | (unify {'a 4} 'a 'b) 93 | 94 | (unify {} 'a 'b) 95 | 96 | (-> {} 97 | (unify 'a 'b) 98 | (unify 'b 4) 99 | (walk 'a)) 100 | 101 | ) 102 | 103 | ;; Now that we have the primitives of our language we can start to build a DSL 104 | ;; We will dealing with streams of environments. We can use almost any construct 105 | ;; that deals with streams of values, but today we'll use transducers. 106 | 107 | (defn == [a b] 108 | (keep #(unify % a b))) 109 | 110 | (comment 111 | (transduce 112 | (== 'a 42) 113 | conj 114 | [{}]) 115 | 116 | ) 117 | 118 | ;; That doesn't give us much, so now we need to define a logical "and" or a conjunction 119 | 120 | (defn conjunction [& clauses] 121 | (apply comp clauses)) 122 | 123 | ;; or.... 124 | 125 | (def conjunction comp) 126 | 127 | (comment 128 | 129 | (transduce 130 | (conjunction 131 | (== 'a 42) 132 | (== 'b 33)) 133 | conj 134 | [{}]) 135 | 136 | (transduce 137 | (conjunction 138 | (== 'a 42) 139 | (== 'b 33) 140 | (== 'a 'b)) 141 | conj 142 | [{}]) 143 | 144 | (transduce 145 | (conjunction 146 | (== 'a 42) 147 | (== 'b 'a)) 148 | conj 149 | [{}]) 150 | 151 | ) 152 | 153 | 154 | ;; It's rather hard to figure out what's going on in the results here, so let's write 155 | ;; a "extract" lvars from results. 156 | 157 | (defn -extractor [sym] 158 | (fn [env] 159 | (walk env sym))) 160 | 161 | (defn extract [& lvars] 162 | (map (apply juxt 163 | (map -extractor lvars)))) 164 | 165 | 166 | (comment 167 | 168 | (transduce 169 | (conjunction 170 | (== 'a 42) 171 | (== 'b 33) 172 | (extract 'a 'b)) 173 | conj 174 | [{}]) 175 | 176 | ) 177 | 178 | ;; And now for logical "or" or a disjunction. In this case we want to pass all 179 | ;; the environments into each of the sub-clauses. 180 | 181 | ;; Copied from clojure.core 182 | (defn ^:private preserving-reduced 183 | [rf] 184 | #(let [ret (rf %1 %2)] 185 | (if (reduced? ret) 186 | (reduced ret) 187 | ret))) 188 | 189 | (defn disjunction [& exprs] 190 | (fn [xf] 191 | (let [fs (mapv (fn [expr] 192 | (preserving-reduced (expr xf))) 193 | exprs)] 194 | (fn 195 | ([] (xf)) 196 | ([acc] (xf acc)) 197 | ([acc itm] 198 | (reduce #(%2 %1 itm) acc fs)))))) 199 | 200 | (comment 201 | 202 | (transduce 203 | (disjunction 204 | (== 'a 42) 205 | (== 'b 33)) 206 | conj 207 | [{}]) 208 | 209 | (transduce 210 | (disjunction 211 | (== 'a 42) 212 | (== 'a 33)) 213 | conj 214 | [{}]) 215 | 216 | (transduce 217 | (conjunction 218 | (disjunction 219 | (== 'a 42) 220 | (== 'a 33)) 221 | (== 'b 'a)) 222 | conj 223 | [{}]) 224 | 225 | (transduce 226 | (conjunction 227 | (disjunction 228 | (== 'a 42) 229 | (== 'a 33)) 230 | (== 'a 33)) 231 | conj 232 | [{}]) 233 | 234 | (transduce 235 | (conjunction 236 | (== 'a 33) 237 | (disjunction 238 | (== 'a 42) 239 | (== 'a 33))) 240 | conj 241 | [{}]) 242 | 243 | (transduce 244 | (conjunction 245 | (== 'b 33) 246 | (== 'a 'b) 247 | (disjunction 248 | (== 'a 42) 249 | (== 'a 33))) 250 | conj 251 | [{}]) 252 | 253 | (transduce 254 | (conjunction 255 | (== 'b 33) 256 | (disjunction 257 | (== 'a 42) 258 | (== 'a 33)) 259 | (== 'a 'b)) 260 | conj 261 | [{}]) 262 | 263 | ;; These all look the same, but they do have different performance profiles. 264 | 265 | ) 266 | 267 | ;; Let's encapsulate the common logic here 268 | 269 | (defn run [& clauses] 270 | (transduce (apply conjunction clauses) conj [{}])) 271 | 272 | (comment 273 | (run (== 1 'a)) 274 | 275 | ) 276 | 277 | 278 | ;; Let's make a database 279 | 280 | (deftype EntID []) 281 | 282 | (defmethod print-method EntID 283 | [x ^Writer w] 284 | (.write w (str "id@" (System/identityHashCode x)))) 285 | 286 | (defn parse-value [v] 287 | (let [result (try 288 | (edn/read-string v) 289 | (catch Throwable _ v))] 290 | (if (symbol? result) 291 | (name result) 292 | result))) 293 | 294 | (defn load-csv [filename] 295 | (with-open [reader (io/reader (io/resource filename))] 296 | (let [[head & tail] (csv/read-csv reader) 297 | head (map keyword head)] 298 | (mapv 299 | (fn [ks vs] 300 | (zipmap ks (map parse-value vs))) 301 | (repeat head) 302 | tail)))) 303 | 304 | 305 | 306 | (defn tuples-for-data [data] 307 | (mapcat 308 | (fn [mp] 309 | (let [id (->EntID)] 310 | (for [[k v] mp] 311 | [id k v]))) 312 | data)) 313 | 314 | (defn categorize-system [{:keys [security] :as system}] 315 | (let [sec-status (cond 316 | (>= security 0.5) :high 317 | (> security 0) :low 318 | :else :null)] 319 | (assoc system :sec-status sec-status))) 320 | 321 | (def solar-systems (->> "mapSolarSystems.csv" 322 | load-csv 323 | (map categorize-system) 324 | tuples-for-data)) 325 | 326 | (def system-jumps (-> "mapSolarSystemJumps.csv" 327 | load-csv 328 | tuples-for-data)) 329 | 330 | (comment 331 | (pprint 332 | (take 100 solar-systems)) 333 | (take 10 system-jumps) 334 | 335 | (into #{} (map :security) (load-csv "mapSolarSystems.csv")) 336 | 337 | (count solar-systems) 338 | 339 | ) 340 | 341 | (def s-conj (fnil conj #{})) 342 | 343 | (defn index-data [data a b] 344 | (reduce 345 | (fn [index tuple] 346 | (update-in index [(tuple a) (tuple b)] s-conj tuple)) 347 | {} 348 | data)) 349 | 350 | (alter-var-root #'index-data memoize) 351 | 352 | (comment 353 | 354 | (time (count (index-data solar-systems 0 1))) 355 | 356 | [ent :solarSystemName "Jita"] 357 | 358 | ) 359 | 360 | (defn index-for 361 | ([data a b av] 362 | (let [idx (index-data data a b)] 363 | (vec (apply concat (vals (get-in idx [av])))))) 364 | ([data a b av bv] 365 | (let [idx (index-data data a b)] 366 | (get-in idx [av bv])))) 367 | 368 | 369 | (defn q [data e a v] 370 | (mapcat 371 | (fn [env] 372 | (->> (let [e' (walk env e) 373 | a' (walk env a) 374 | v' (walk env v)] 375 | (condp = [(grounded? e') (grounded? a') (grounded? v')] 376 | [false true true] (for [[e] (index-for data 1 2 a' v')] 377 | (unify env e e')) 378 | [true true false] (for [[_ _ v] (index-for data 0 1 e' a')] 379 | (unify env v v')) 380 | [false true false] (for [[e _ v] (index-for data 1 2 a')] 381 | (-> env 382 | (unify e e') 383 | (unify v v'))) 384 | [true true true] (for [[_ _ v] (index-for data 0 1 e' a')] 385 | (unify env v v')))) 386 | (remove nil?))))) 387 | 388 | (defmacro with-fresh [& body] 389 | (let [lvars (->> body 390 | flatten 391 | (filter simple-symbol?) 392 | (remove #(contains? &env %)) 393 | (filter #(str/starts-with? (name %) "?")))] 394 | `(let [~@(interleave 395 | lvars 396 | (map 397 | (fn [sym] 398 | `(gensym ~(name sym))) 399 | lvars))] 400 | ~@body))) 401 | 402 | (comment 403 | 404 | (macroexpand '(with-fresh ?e ?a)) 405 | 406 | (with-fresh 407 | (run 408 | (q solar-systems ?id :solarSystemName "Jita") 409 | (q solar-systems ?id :sec-status ?sec) 410 | (extract ?sec))) 411 | 412 | (with-fresh 413 | (run 414 | (q solar-systems ?id :sec-status :high) 415 | (q solar-systems ?id :solarSystemName ?name) 416 | (extract ?name))) 417 | 418 | (with-fresh 419 | (run 420 | (q solar-systems ?id :solarSystemName ?name) 421 | (q solar-systems ?id :sec-status :high) 422 | (extract ?name))) 423 | 424 | ) 425 | 426 | ;; We can write query composers to move up a level of abstraction 427 | (defn jumps-to [?from ?to] 428 | (with-fresh 429 | (conjunction 430 | (q solar-systems ?from :solarSystemID ?from-id) 431 | (q system-jumps ?jump :fromSolarSystemID ?from-id) 432 | (q system-jumps ?jump :toSolarSystemID ?to-id) 433 | (q solar-systems ?to :solarSystemID ?to-id)))) 434 | 435 | (comment 436 | ;; Keys in system jumps table 437 | (into #{} (map second system-jumps)) 438 | (into #{} (map second solar-systems)) 439 | 440 | ;; Systems connected to Jita 441 | (with-fresh 442 | (run 443 | (q solar-systems ?jita :solarSystemName "Jita") 444 | (jumps-to ?jita ?to) 445 | (q solar-systems ?to :solarSystemName ?to-name) 446 | (extract ?to-name))) 447 | 448 | ;; Border Systems (low sec that jumps to high sec) 449 | (with-fresh 450 | (run 451 | (q solar-systems ?from :sec-status :low) 452 | (q solar-systems ?from :solarSystemName ?from-name) 453 | (jumps-to ?from ?to) 454 | (q solar-systems ?to :sec-status :high) 455 | (q solar-systems ?to :solarSystemName ?to-name) 456 | 457 | ;; Grab real sec of both systems 458 | (q solar-systems ?from :security ?from-sec) 459 | (q solar-systems ?to :security ?to-sec) 460 | (extract ?from-name ?from-sec ?to-name ?to-sec))) 461 | 462 | ;; Systems that have both high and low neighbors (30ms on my system) 463 | (time 464 | (with-fresh 465 | (run 466 | (q solar-systems ?low :sec-status :low) 467 | (q solar-systems ?low :solarSystemName ?low-name) 468 | (jumps-to ?low ?high) 469 | (q solar-systems ?high :sec-status :high) 470 | (q solar-systems ?high :solarSystemName ?high-name) 471 | (jumps-to ?low ?null) 472 | (q solar-systems ?null :sec-status :null) 473 | (q solar-systems ?null :solarSystemName ?null-name) 474 | 475 | (extract ?null-name ?low-name ?high-name)))) 476 | 477 | 478 | (count 479 | (with-fresh 480 | (run 481 | (q solar-systems ?id :solarSystemName ?name)))) 482 | 483 | ;; DON'T RUN! 484 | ;; Same as prev, but with bad ordering, never completes 485 | (time 486 | (with-fresh 487 | (run 488 | (q solar-systems ?low :sec-status :low) ; 8K stars 489 | (q solar-systems ?high :sec-status :high) ; * 8K stars 490 | (q solar-systems ?null :sec-status :null) ; * 8K stars 491 | 492 | (jumps-to ?low ?high) ; 512 billion combinations 493 | (jumps-to ?low ?null) 494 | 495 | (q solar-systems ?low :solarSystemName ?low-name) 496 | (q solar-systems ?high :solarSystemName ?high-name) 497 | (q solar-systems ?null :solarSystemName ?null-name) 498 | 499 | (extract ?null-name ?low-name ?high-name)))) 500 | 501 | ) 502 | 503 | ;; Let's think about representing the queries as ASTs 504 | 505 | (defn q-ast [data e a v] 506 | (assert (var? data)) 507 | {:op :q 508 | :e e 509 | :a a 510 | :v v 511 | :data data}) 512 | 513 | (defn and-ast [& clauses] 514 | (let [clauses (mapcat 515 | (fn [{:keys [op clauses] :as clause}] 516 | (if (= op :and) 517 | clauses 518 | [clause])) 519 | clauses)] 520 | {:op :and 521 | :clauses (vec clauses)})) 522 | 523 | (defn extract-ast [& lvars] 524 | {:op :extract 525 | :lvars (vec lvars)}) 526 | 527 | (defn jumps-to-ast [?from ?to] 528 | (with-fresh 529 | (and-ast 530 | (q-ast #'solar-systems ?from :solarSystemID ?from-id) 531 | (q-ast #'system-jumps ?jump :fromSolarSystemID ?from-id) 532 | (q-ast #'system-jumps ?jump :toSolarSystemID ?to-id) 533 | (q-ast #'solar-systems ?to :solarSystemID ?to-id)))) 534 | 535 | (comment 536 | 537 | ;; Print the constructed AST 538 | (pprint 539 | (with-fresh 540 | (and-ast 541 | (q-ast #'solar-systems ?low :sec-status :low) ; 8K stars 542 | (q-ast #'solar-systems ?high :sec-status :high) ; * 8K stars 543 | (q-ast #'solar-systems ?null :sec-status :null) ; * 8K stars 544 | 545 | (jumps-to-ast ?low ?high) ; 512 billion combinations 546 | (jumps-to-ast ?low ?null) 547 | 548 | (q-ast #'solar-systems ?low :solarSystemName ?low-name) 549 | (q-ast #'solar-systems ?high :solarSystemName ?high-name) 550 | (q-ast #'solar-systems ?null :solarSystemName ?null-name) 551 | 552 | (extract-ast ?null-name ?low-name ?high-name)))) 553 | 554 | ) 555 | 556 | 557 | ;; Now let's write an AST sorter 558 | (defmulti attempt-sort (fn [bound {:keys [op]}] 559 | op)) 560 | 561 | (defmethod attempt-sort :and 562 | [bound {:keys [clauses]}] 563 | (let [extracts (filter #(= (:op %) :extract) clauses) 564 | clauses (remove (set extracts) clauses)] 565 | 566 | ;; so now we'll loop, finding clauses that can bind against 567 | (loop [bound bound 568 | remain (set clauses) 569 | sorted []] 570 | (if (seq remain) 571 | (let [next-node (->> remain 572 | (keep #(attempt-sort bound %)) 573 | ;; Only perform left-joins 574 | (filter #(set/subset? bound (:join/bound %))) 575 | (sort-by :join/cost) 576 | first)] 577 | (assert next-node "Can't sort, can't find next node!") 578 | (recur (set/union bound (:join/bound next-node)) 579 | (disj remain (dissoc next-node :join/bound :join/cost)) 580 | (conj sorted (assoc next-node :join/pre-bound bound)))) 581 | {:op :and 582 | :clauses (vec (concat sorted extracts))})))) 583 | 584 | (defn average-size [colls] 585 | (let [sizes (mapv count colls)] 586 | (/ (reduce + 0 sizes) 587 | (count sizes)))) 588 | 589 | (let [grounded? (fn [bound v] 590 | (cond 591 | (grounded? v) :const 592 | (contains? bound v) :bound 593 | :else :unbound)) 594 | index-for (memoize 595 | (fn [data & args] 596 | (apply index-for @data args))) 597 | ;; This counting needs to be cached to get fast query sorting. There's dozens ways 598 | ;; of doing this, this is a quick-and-dirty method. Production code should use something 599 | ;; much more robust. 600 | calc-bcu (memoize 601 | (fn [data a] 602 | (average-size (group-by first (index-for data 1 0 a))))) 603 | calc-ucb (memoize 604 | (fn [data a] 605 | (average-size (group-by last (index-for data 1 2 a)))))] 606 | 607 | (defmethod attempt-sort :q 608 | [bound {:keys [e a v data] :as node}] 609 | (condp = [(grounded? bound e) (grounded? bound a) (grounded? bound v)] 610 | [:unbound :const :unbound] (assoc node :join/bound (conj bound e v) 611 | :join/cost (count (index-for data 1 2 a))) 612 | [:bound :const :bound] (assoc node :join/bound bound 613 | :join/cost 1) 614 | [:unbound :const :const] (assoc node :join/bound (conj bound e v) 615 | :join/cost (count (index-for data 1 2 a v))) 616 | 617 | [:bound :const :unbound] (assoc node :join/bound (conj bound v) 618 | :join/cost (calc-bcu data a)) 619 | [:bound :const :const] (assoc node :join/bound (conj bound e v) 620 | :join/cost 1) 621 | [:unbound :const :bound] (assoc node :join/bound (conj bound e) 622 | :join/cost (calc-ucb data a))))) 623 | 624 | (comment 625 | 626 | (def q-ast (with-fresh 627 | (and-ast 628 | (q-ast #'solar-systems ?low :sec-status :low) ; 8K stars 629 | (q-ast #'solar-systems ?high :sec-status :high) ; * 8K stars 630 | (q-ast #'solar-systems ?null :sec-status :null) ; * 8K stars 631 | 632 | (jumps-to-ast ?low ?high) ; 512 billion combinations 633 | (jumps-to-ast ?low ?null) 634 | 635 | (q-ast #'solar-systems ?low :solarSystemName ?low-name) 636 | (q-ast #'solar-systems ?high :solarSystemName ?high-name) 637 | (q-ast #'solar-systems ?null :solarSystemName ?null-name) 638 | 639 | (extract-ast ?null-name ?low-name ?high-name)))) 640 | 641 | (def q-ast-sorted (time (attempt-sort #{} q-ast))) 642 | 643 | (pprint (map (juxt :e :a :v) (:clauses q-ast-sorted))) 644 | 645 | ) 646 | 647 | (defmulti gen-query :op) 648 | 649 | (defmethod gen-query :and 650 | [{:keys [clauses]}] 651 | (apply conjunction (map gen-query clauses))) 652 | 653 | (defmethod gen-query :q 654 | [{:keys [data e a v]}] 655 | (q @data e a v)) 656 | 657 | (defmethod gen-query :extract 658 | [{:keys [lvars]}] 659 | (apply extract lvars)) 660 | 661 | (comment 662 | 663 | (time (run (gen-query q-ast-sorted))) 664 | 665 | ) 666 | 667 | (def gen-clj nil) 668 | (defmulti gen-clj (fn [inner {:keys [op]}] 669 | op)) 670 | 671 | (defmethod gen-clj :and 672 | [inner {:keys [clauses]}] 673 | (reduce 674 | gen-clj 675 | inner 676 | (reverse clauses))) 677 | 678 | (defmethod gen-clj :extract 679 | [inner {:keys [lvars]}] 680 | `(let [~'result ~(vec lvars)] 681 | ~inner)) 682 | 683 | (defmacro sdoseq 684 | "Simple doseq" 685 | [[bind coll] & body] 686 | `(loop [result# (seq ~coll)] 687 | (when (seq result#) 688 | (let [~bind (first result#)] 689 | ~@body 690 | (recur (next result#)))))) 691 | 692 | (let [grounded? (fn [bound v] 693 | (cond 694 | (grounded? v) :const 695 | (contains? bound v) :bound 696 | :else :unbound))] 697 | (defmethod gen-clj :q 698 | [inner {:keys [e a v join/pre-bound ^clojure.lang.Var data]}] 699 | (let [data (symbol 700 | (name (.-name (.-ns data))) 701 | (name (.-sym data)))] 702 | (condp = [(grounded? pre-bound e) (grounded? pre-bound a) (grounded? pre-bound v)] 703 | 704 | [:bound :const :unbound] 705 | `(sdoseq [[~'_ ~'_ ~v] (~'index-for (~'deref (var ~data)) 0 1 ~e ~a)] 706 | ~inner) 707 | 708 | [:bound :const :const] 709 | `(sdoseq [[~'_ ~'_ v#] (~'index-for (~'deref (var ~data)) 0 1 ~e ~a)] 710 | (when (= v# ~v) 711 | ~inner)) 712 | 713 | [:unbound :const :bound] 714 | `(sdoseq [[~e] (~'index-for (~'deref (var ~data)) 1 2 ~a ~v)] 715 | ~inner) 716 | 717 | [:unbound :const :unbound] 718 | `(sdoseq [[~e ~'_ ~v] (~'index-for (~'deref (var ~data)) 1 0 ~a)] 719 | ~inner) 720 | 721 | [:unbound :const :const] 722 | `(sdoseq [[~e] (~'index-for (~'deref (var ~data)) 1 2 ~a ~v)] 723 | ~inner))))) 724 | 725 | (defn compile [ast] 726 | (let [sexpr `(fn [] 727 | (let [~'results (volatile! (transient []))] 728 | ~(gen-clj `(vswap! ~'results conj! ~'result) ast) 729 | (persistent! @~'results)))] 730 | (eval sexpr))) 731 | 732 | (comment 733 | 734 | (sdoseq [[x y] (map (juxt inc dec) (range 10))] 735 | (println [x y])) 736 | 737 | (pprint (gen-clj `(identity ~'result) q-ast-sorted)) 738 | 739 | (index-for (deref #'solar-systems 1 0 :sec)) 740 | 741 | (time (compile q-ast-sorted)) 742 | 743 | (time ((compile q-ast-sorted))) 744 | 745 | (let [f (compile q-ast-sorted)] 746 | (dotimes [x 100] 747 | (time (f)))) 748 | 749 | ) 750 | 751 | ;; Points of future extension 752 | ;; 1) Use nested cases instead of condp 753 | ;; 2) Allow parameters to be passed to compiled functions 754 | ;; 3) Support merge joins 755 | ;; 4) Support recursive rules 756 | ;; 5) Support partial evaluation (with code-expressions?) 757 | 758 | 759 | --------------------------------------------------------------------------------