# HG changeset patch # User Richard Westhaver # Date 1712876315 14400 # Node ID 1ef551e24009b765e9b07cb8d0f8633192ac4326 # Parent 8259376eee111be50533beba3621fd2e5c78344e added musicbrainz db example diff -r 8259376eee11 -r 1ef551e24009 examples/db/cl-simple-example-raw.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/db/cl-simple-example-raw.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -0,0 +1,66 @@ +;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/examples/c_simple_example.c + +;; ref: https://github.com/facebook/rocksdb/blob/main/examples/c_simple_example.c + +;;; Usage: + +;; To compile and run from the shell: +#| +sbcl --eval '(ql:quickload :rdb)' \ + --eval '(ql:quickload :cli)' \ + --eval '(compile-file "cl-simple-example.lisp")' \ + --eval '(load "cl-simple-example.fasl")' \ + --eval "(sb-ext:save-lisp-and-die \"cl-simple-example\" :toplevel #'cl-simple-example::main :executable t)" + +time ./cl-simple-example + +# real 0m0.030s +# user 0m0.012s +# sys 0m0.017s +|# + +;; Compare to C: +#| +# in rocksdb/examples +gcc -lrocksdb c_simple_example.c -oc_simple_example + +time ./c_simple_example + +# real 0m0.021s +# user 0m0.006s +# sys 0m0.015s +|# + +;;; Code: +(defpackage :examples/cl-simple-example-raw + (:use :cl :std :cli :rdb :sb-alien :rocksdb) + (:export :main)) + +(in-package :examples/cl-simple-example-raw) +(declaim (optimize (speed 3))) + +(defparameter *num-cpus* (num-cpus) + "CPU count.") + +(defparameter *db-path* "/tmp/rocksdb-cl-simple-example-raw") + +(defparameter *db-backup-path* "/tmp/rocksdb-cl-simple-example-backup-raw") + +(defmain () + ;; open Backup Engine that we will use for backing up our database + (let ((options (make-rocksdb-options + (lambda (opt) + (rocksdb-options-increase-parallelism opt *num-cpus*) ;; set # of online cores + (rocksdb-options-optimize-level-style-compaction opt 0) + (rocksdb-options-set-create-if-missing opt 1))))) + (with-open-backup-engine-raw (be *db-backup-path* options) + ;; open DB + (with-open-db-raw (db *db-path* options) + ;; put key-value + (put-kv-str-raw db "key" "value") + ;; get value + (string= (get-kv-str-raw db "key") "value") + ;; create new backup in a directory specified by *db-backup-path* + (create-new-backup-raw be db)) + ;; if something is wrong, you might want to restore data from last backup + (restore-from-latest-backup-raw be *db-path* *db-backup-path*)))) diff -r 8259376eee11 -r 1ef551e24009 examples/db/cl-simple-example.lisp --- a/examples/db/cl-simple-example.lisp Fri Dec 29 00:45:44 2023 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/examples/c_simple_example.c - -;; ref: https://github.com/facebook/rocksdb/blob/main/examples/c_simple_example.c - -;;; Usage: - -;; To compile and run from the shell: -#| -sbcl --eval '(ql:quickload :rdb)' \ - --eval '(ql:quickload :cli)' \ - --eval '(compile-file "cl-simple-example.lisp")' \ - --eval '(load "cl-simple-example.fasl")' \ - --eval "(sb-ext:save-lisp-and-die \"cl-simple-example\" :toplevel #'cl-simple-example::main :executable t)" - -time ./cl-simple-example - -# real 0m0.030s -# user 0m0.012s -# sys 0m0.017s -|# - -;; Compare to C: -#| -# in rocksdb/examples -gcc -lrocksdb c_simple_example.c -oc_simple_example - -time ./c_simple_example - -# real 0m0.021s -# user 0m0.006s -# sys 0m0.015s -|# - -;;; Code: -(defpackage :examples/cl-simple-example - (:use :cl :std :cli :rdb :sb-alien :rocksdb) - (:export :main)) - -(in-package :examples/cl-simple-example) -(declaim (optimize (speed 3))) - -(defvar *num-cpus* (alien-funcall (extern-alien "sysconf" (function int int)) sb-unix:sc-nprocessors-onln) - "CPU count.") - -(defparameter *db-path* "/tmp/rocksdb-cl-simple-example") - -(defparameter *db-backup-path* "/tmp/rocksdb-cl-simple-example-backup") - -(defmain () - ;; open Backup Engine that we will use for backing up our database - (let ((options (make-rocksdb-options - (lambda (opt) - (rocksdb-options-increase-parallelism opt *num-cpus*) ;; set # of online cores - (rocksdb-options-optimize-level-style-compaction opt 0) - (rocksdb-options-set-create-if-missing opt 1))))) - (with-open-backup-engine-raw (be *db-backup-path* options) - ;; open DB - (with-open-db-raw (db *db-path* options) - ;; put key-value - (put-kv-str-raw db "key" "value") - ;; get value - (string= (get-kv-str-raw db "key") "value") - ;; create new backup in a directory specified by *db-backup-path* - (create-new-backup-raw be db)) - ;; if something is wrong, you might want to restore data from last backup - (restore-from-latest-backup-raw be *db-path* *db-backup-path*)))) diff -r 8259376eee11 -r 1ef551e24009 examples/db/mbdb.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/db/mbdb.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -0,0 +1,48 @@ +;;; examples/mbdb.lisp --- MusicBrainz Database import and analysis + +;; This example show how to migrate a set of complex JSON objects to +;; RocksDB using a dump from the MusicBrainz database +;; (https://musicbrainz.org/). The files are hosted at +;; https://packy.compiler.company/data/mbdump + +;;; Code: +(defpackage :examples/mbdb + (:use :cl :std :dat/json :net/fetch :obj/id :rdb :cli/clap :obj/uuid) + (:import-from :log :info! :debug!) + (:import-from :rocksdb :load-rocksdb) + (:export :main)) + +(in-package :examples/mbdb) + +(load-rocksdb t) + +(declaim (type pathname *mbdb-path*)) +(defvar *mbdb-path* #P"/tmp/mbdb/") +(defvar *mbdb* (create-db *mbdb-path* :opts (default-rdb-opts))) + +(defvar *mbdump-base-url* "https://packy.compiler.company/data/mbdump/" + "Remote location of MusicBrainz JSON data files.") + +(defvar *mbdump-files* + (mapcar (lambda (f) (make-pathname :name f :type "json" :directory *mbdump-base-url*)) + (list "area" "artist" "event" "instrument" + "label" "place" "recording" "release" + "release-group" "series" "work"))) + +(defun extract-columns (obj) + "Extract fields from a JSON-OBJECT, returning a vector of + uninitialized column-families which can be created with CREATE-CFS. + +Returns multiple values: the list of columns, the id, and type-id if present." + (values + (mapcar #'car (json-object-members obj)) + (make-uuid-from-string (json-getf obj "id")) + (when-let ((tid (json-getf obj "type-id"))) + (make-uuid-from-string tid)))) + +(defmain () + (let ((*default-pathname-defaults* (ensure-directories-exist *mbdb-path* :verbose t))) + (log:info! "Welcome to MBDB") + (with-db (db *mbdb*) + (open-db db) + (close-db db)))) diff -r 8259376eee11 -r 1ef551e24009 examples/db/mini-redis.lisp --- a/examples/db/mini-redis.lisp Fri Dec 29 00:45:44 2023 -0500 +++ b/examples/db/mini-redis.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -12,7 +12,7 @@ (in-package :examples/mini-redis) -(defparameter *worker-count* 4) +(defparameter *worker-count* 8) (defparameter *writer-proportion* 0.5) (defvar *keys* (loop for n below 130 by 2 diff -r 8259376eee11 -r 1ef551e24009 examples/db/tao.lisp --- a/examples/db/tao.lisp Fri Dec 29 00:45:44 2023 -0500 +++ b/examples/db/tao.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -6,9 +6,85 @@ ;;; Code: (defpackage :examples/tao - (:use :cl :std :cli :rdb) - (:export :main)) + (:use :cl :std :rdb :log :obj/db :obj/graph :obj/id) + (:export :run-tao)) (in-package :examples/tao) -(defmain ()) +(rdb::load-rocksdb) + +(defvar *tao-directory* "/tmp/tao/") + +(defvar *tao-log-dir*) +(defvar *tao-db-dir*) +(defvar *tao-cfs* + (vector (make-rdb-cf "nodes") + (make-rdb-cf "edges"))) + +(defun tao-path (path &optional (root *tao-directory*)) + (merge-pathnames path root)) + +(defclass tao-node (id) + (key val)) + +(defclass tao-edge (edge) ()) + +(defclass tao-graph (graph) ()) + +(defclass tao-db (database) + ((db :type rdb))) + +(defclass tao (tao-db tao-graph) + ((dir :initarg :dir))) + +(defun ensure-tao-directories (&optional (root *tao-directory*)) + (setf *tao-log-dir* (ensure-directories-exist (tao-path "log/" root) :verbose t)) + root) + +(defun init-tao-db (&optional (root *tao-directory*)) + (let ((db-dir (tao-path "db/" root))) + (setf *tao-db-dir* db-dir) + (create-db db-dir :cfs *tao-cfs*))) + +(defun make-tao (&key (dir *tao-directory*)) + (make-instance 'tao + :dir (setf *tao-directory* (ensure-tao-directories dir)) + :db (init-tao-db dir))) + +(defun run-tao () + (let ((opts (default-rdb-opts))) ;; configure database options + (set-opt opts "error-if-exists" 0) + (set-opt opts "db-log-dir" "/tmp/log") + (push-sap* opts) + (let ((db (create-db "tao" + :opts opts + ;; :cfs (vector (make-rdb-cf "nodes") + ;; (make-rdb-cf "edges")) + :open t))) + (with-db (db db) + (flush-db db) + (let ((metadata (get-metadata db))) + (info! + (rdb::rocksdb-column-family-metadata-get-name metadata) + (rdb::rocksdb-column-family-metadata-get-size metadata) + (rdb::rocksdb-column-family-metadata-get-file-count metadata) + (rdb::rocksdb-column-family-metadata-get-level-count metadata)) + (let ((lmeta (rdb::rocksdb-column-family-metadata-get-level-metadata metadata 0))) + (info! + (rdb::rocksdb-level-metadata-get-level lmeta) + (rdb::rocksdb-level-metadata-get-size lmeta) + (rdb::rocksdb-level-metadata-get-file-count lmeta)) + ;; TODO: requires file-count > 0 + ;; (let ((smeta (rdb::rocksdb-level-metadata-get-sst-file-metadata lmeta 0))) + ;; (info! + ;; (rdb::rocksdb-sst-file-metadata-get-directory smeta) + ;; (rdb::rocksdb-sst-file-metadata-get-relative-filename smeta) + ;; (rdb::rocksdb-sst-file-metadata-get-size smeta) + ;; (rdb::rocksdb-sst-file-metadata-get-smallestkey smeta) + ;; (rdb::rocksdb-sst-file-metadata-get-largestkey smeta)) + ;; (rdb::rocksdb-sst-file-metadata-destroy smeta)) + (rdb::rocksdb-level-metadata-destroy lmeta)) + (rdb::rocksdb-column-family-metadata-destroy metadata)) + (info! (get-prop db "rocksdb.stats")) + (close-db db)))) + (info! "TAO OK")) diff -r 8259376eee11 -r 1ef551e24009 examples/examples.asd --- a/examples/examples.asd Fri Dec 29 00:45:44 2023 -0500 +++ b/examples/examples.asd Thu Apr 11 18:58:35 2024 -0400 @@ -1,9 +1,10 @@ (defsystem :examples - :depends-on (:std :cli :obj :dat :net :rdb) + :depends-on (:prelude) :components ((:file "vegadat") (:module "db" - :components ((:file "cl-simple-example") + :components ((:file "cl-simple-example-raw") (:file "mini-redis") - (:file "tao"))))) + (:file "tao") + (:file "mbdb" :depends-on nil))))) diff -r 8259376eee11 -r 1ef551e24009 examples/vegadat.lisp --- a/examples/vegadat.lisp Fri Dec 29 00:45:44 2023 -0500 +++ b/examples/vegadat.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -8,7 +8,7 @@ (in-package :examples/vegadat) (defparameter *vega-dataset-base-url* "http://raw.githubusercontent.com/vega/vega-datasets/main/data/" - "Base URL for datasets included in Vega") + "Base URL for datasets included in Vega.") (defparameter *vega-dataset-stash* "vega/") diff -r 8259376eee11 -r 1ef551e24009 tools/build-cli.lisp --- a/tools/build-cli.lisp Fri Dec 29 00:45:44 2023 -0500 +++ b/tools/build-cli.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -3,7 +3,7 @@ #+sbcl (sb-ext:save-lisp-and-die *output* :purify t - :toplevel 'screenshotbot-sdk:main + :toplevel 'homer:main :executable t) #+ccl (ccl:save-application *output* diff -r 8259376eee11 -r 1ef551e24009 tools/build-image.lisp --- a/tools/build-image.lisp Fri Dec 29 00:45:44 2023 -0500 +++ b/tools/build-image.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -8,10 +8,6 @@ (defun image-load-hook () ;; On MacOS, the TMPDIR variable can change between sessions. (uiop:setup-temporary-directory) - - #-sbcl - (log4cl::init-hook) - ;; If we used this image to deliver another image, we don't ;; want to load the same hook twice (unless *hook-loaded-p* @@ -20,32 +16,13 @@ (compile 'image-load-hook) -#+sbcl (pushnew 'image-load-hook sb-ext:*init-hooks*) (format t "Got command line arguments: ~S" (uiop:raw-command-line-arguments)) -#-sbcl -(log4cl::save-hook) - -#+sbcl (sb-ext:save-lisp-and-die (namestring (make-pathname #+win32 :type #+win32 "exe" :defaults #P"build/sbcl-console")) :executable t) - -#+ccl -(defun ccl-toplevel-function () - (image-load-hook) - (let ((file (cadr ccl:*command-line-argument-list*))) - (if file - (load file :verbose t) - (loop - (print (eval (read))))))) - - -#+ccl -(ccl:save-application "build/ccl-console" - :toplevel-function 'ccl-toplevel-function) diff -r 8259376eee11 -r 1ef551e24009 tools/prepare-image.lisp --- a/tools/prepare-image.lisp Fri Dec 29 00:45:44 2023 -0500 +++ b/tools/prepare-image.lisp Thu Apr 11 18:58:35 2024 -0400 @@ -1,59 +1,20 @@ (in-package :cl-user) -;; For SBCL, if you don't have SBCL_HOME set, then we won't be able to require this later. -#+sbcl -(require 'sb-introspect) -#-sbcl -(require "asdf") - -#+sbcl -(require "sb-sprof") - -(defvar *cwd* (uiop:getcwd)) - -(defun update-output-translations (root) - (asdf:initialize-output-translations - `(:output-translations - :inherit-configuration - (,(namestring root) - ,(format nil "~abuild/asdf-cache/~a/" root - (uiop:implementation-identifier)))))) - -(update-output-translations *cwd*) - -#+sbcl -(progn - (require :sb-rotate-byte) - (require :sb-cltl2) - (asdf:register-preloaded-system :sb-rotate-byte) - (asdf:register-preloaded-system :sb-cltl2)) +(require :sb-introspect) +(require :asdf) +(require :sb-sprof) +(require :sb-rotate-byte) +(require :sb-cltl2) +(asdf:register-preloaded-system :sb-rotate-byte) +(asdf:register-preloaded-system :sb-cltl2) +(asdf:register-preloaded-system :std) +(asdf:register-preloaded-system :log) (ql:update-all-dists :prompt nil) -;; is the package name already loaded as a feature? uhh look it up (pushnew :demo *features*) -(defun update-project-directories (cwd) - (flet ((push-src-dir (name) - (let ((dir (pathname (format nil "~a~a/" cwd name)))) - (when (probe-file dir) - (push dir ql:*local-project-directories*))))) - #-demo - (push-src-dir ".") - (push-src-dir "vendor"))) - -(update-project-directories *cwd*) +(ql:quickload :prelude) +(ql:register-local-projects) +(log:info! "*local-project-directories:" ql:*local-project-directories*) -(defun maybe-configure-proxy () - (let ((proxy (uiop:getenv "HTTP_PROXY"))) - (when (and proxy (> (length proxy) 0)) - (setf ql:*proxy-url* proxy)))) - -(maybe-configure-proxy) - -(ql:quickload "log4cl") -(ql:quickload "prove-asdf") - -(log:info "*local-project-directories: ~S" ql:*local-project-directories*) - -(ql:register-local-projects)