1.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2+++ b/examples/clos/fast-def.lisp Sun Apr 14 20:48:05 2024 -0400
1.3@@ -0,0 +1,8 @@
1.4+(in-package :examples/clos/fast)
1.5+
1.6+(defgeneric binary-+ (x y)
1.7+ (:generic-function-class fast-generic-function))
1.8+
1.9+(defmethod binary-+ ((x fixnum) (y fixnum))
1.10+ (declare (method-properties inlineable))
1.11+ (the fixnum (+ x y)))
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/examples/clos/fast.lisp Sun Apr 14 20:48:05 2024 -0400
2.3@@ -0,0 +1,15 @@
2.4+(in-package :examples/clos/fast)
2.5+
2.6+;; (defclass foo (obj/meta/sealed:sealable-class)
2.7+;; ((n :initform 0 :type fixnum :accessor foo-n)))
2.8+
2.9+;; (defmethod binary-+ ((x foo) (y foo))
2.10+;; (+ (foo-n x) (foo-n y)))
2.11+
2.12+(defmethod binary-+ ((x fixnum) (y fixnum))
2.13+ (declare (method-properties inlineable))
2.14+ (+ x y))
2.15+
2.16+(seal-domain #'binary-+ '(t t))
2.17+(binary-+ 0 0)
2.18+
3.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
3.2+++ b/examples/clos/filtered.lisp Sun Apr 14 20:48:05 2024 -0400
3.3@@ -0,0 +1,1 @@
3.4+(in-package :examples/clos/filtered)
4.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
4.2+++ b/examples/clos/pkg.lisp Sun Apr 14 20:48:05 2024 -0400
4.3@@ -0,0 +1,17 @@
4.4+(in-package :std-user)
4.5+
4.6+(defpkg :examples/clos/sealed
4.7+ (:use :cl :std :obj/meta/sealed))
4.8+
4.9+;; (defpkg :examples/clos/fast
4.10+;; (:use :cl :std :obj/meta/fast))
4.11+
4.12+(defpkg :examples/clos/stealth
4.13+ (:use :cl :std :obj/meta/stealth))
4.14+
4.15+(defpkg :examples/clos/filtered
4.16+ (:use :cl :std :obj/meta/filtered))
4.17+
4.18+(defpkg :examples/clos
4.19+ (:use :cl :std :obj)
4.20+ (:use-reexport :examples/clos/sealed :examples/clos/stealth :examples/clos/filtered))
5.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
5.2+++ b/examples/clos/readme.txt Sun Apr 14 20:48:05 2024 -0400
5.3@@ -0,0 +1,2 @@
5.4+This directory contains examples of advanced CLOS features supported
5.5+by the core. See the OBJ/META package for details.
6.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
6.2+++ b/examples/clos/sealed.lisp Sun Apr 14 20:48:05 2024 -0400
6.3@@ -0,0 +1,1 @@
6.4+(in-package :examples/clos/sealed)
7.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
7.2+++ b/examples/clos/stealth.lisp Sun Apr 14 20:48:05 2024 -0400
7.3@@ -0,0 +1,1 @@
7.4+(in-package :examples/clos/stealth)
9.1--- a/examples/db/mbdb.lisp Thu Apr 11 18:58:35 2024 -0400
9.2+++ b/examples/db/mbdb.lisp Sun Apr 14 20:48:05 2024 -0400
9.3@@ -5,10 +5,19 @@
9.4 ;; (https://musicbrainz.org/). The files are hosted at
9.5 ;; https://packy.compiler.company/data/mbdump
9.6
9.7+;; we parse some of the database schema from the sql files here:
9.8+;; https://github.com/metabrainz/musicbrainz-server/tree/master/admin/sql
9.9+
9.10 ;;; Code:
9.11 (defpackage :examples/mbdb
9.12- (:use :cl :std :dat/json :net/fetch :obj/id :rdb :cli/clap :obj/uuid)
9.13+ (:use :cl :std :dat/json :net/fetch :obj/id :rdb :cli/clap :obj/uuid
9.14+ :sb-concurrency :log :dat/csv :dat/proto :sb-thread)
9.15+ (:import-from :obj/uuid :make-uuid-from-string)
9.16+ (:import-from :cli/progress :with-progress-bar :make-progress-bar
9.17+ :*progress-bar* :*progress-bar-enabled* :update-progress)
9.18+ (:import-from :obj/time :parse-timestring :now :timestamp)
9.19 (:import-from :log :info! :debug!)
9.20+ (:import-from :obj/uri :parse-uri)
9.21 (:import-from :rocksdb :load-rocksdb)
9.22 (:export :main))
9.23
9.24@@ -16,33 +25,291 @@
9.25
9.26 (load-rocksdb t)
9.27
9.28+;;; Vars
9.29+(declaim (timestamp *mbdb-epoch*))
9.30+(defvar *mbdb-epoch* (now)
9.31+ "mbdb time of birth.")
9.32+
9.33+;; (defvar *mbdb-logger* (make-logger))
9.34+
9.35 (declaim (type pathname *mbdb-path*))
9.36 (defvar *mbdb-path* #P"/tmp/mbdb/")
9.37-(defvar *mbdb* (create-db *mbdb-path* :opts (default-rdb-opts)))
9.38+
9.39+(defvar *default-mbdb-opts*
9.40+ (let ((opts (default-rdb-opts)))
9.41+ (set-opt opts :enable-statistics 1)
9.42+ opts))
9.43+
9.44+(declaim (rdb *mbdb*))
9.45+(defvar *mbdb* (create-db *mbdb-path* :opts *default-mbdb-opts* :open nil)
9.46+ "The local MusicBrainz database. The default value is an uninitialized
9.47+instance without any columns. Before use, make sure to open the
9.48+database and on exit the database must be closed.")
9.49+
9.50+(declaim (oracle *mbdb-oracle*))
9.51+(defvar *mbdb-oracle* (make-oracle sb-thread:*current-thread*)
9.52+ "The oracle assigned to the mbdb system, which should usually be the current thread.")
9.53+
9.54+(declaim (task-pool *mbdb-tasks*))
9.55+(defvar *mbdb-tasks* (make-task-pool :oracle *mbdb-oracle*)
9.56+ "The mbdb task pool. This object holds a queue of jobs which are
9.57+dispatched to workers. Results are collected and processed by the
9.58+oracle.")
9.59+
9.60+(defvar *mbsamp-pack-url* "https://packy.compiler.company/data/mbsamp.tar.zst"
9.61+ "Remote location of MusicBrainz ZST-compressed archive filled with TSV
9.62+files.")
9.63
9.64 (defvar *mbdump-base-url* "https://packy.compiler.company/data/mbdump/"
9.65 "Remote location of MusicBrainz JSON data files.")
9.66
9.67-(defvar *mbdump-files*
9.68- (mapcar (lambda (f) (make-pathname :name f :type "json" :directory *mbdump-base-url*))
9.69- (list "area" "artist" "event" "instrument"
9.70- "label" "place" "recording" "release"
9.71- "release-group" "series" "work")))
9.72+(defvar *mbdump-pack-url* "https://packy.compiler.company/data/mbdump.tar.zst"
9.73+ "Remote locaton of MusicBrainz JSON dump pack.")
9.74+
9.75+(defvar *mbdump-pack* (merge-pathnames "mbdump.tar.zst" *mbdb-worker-dir*))
9.76+(defvar *mbsamp-pack* (merge-pathnames "mbsamp.tar.zst" *mbdb-worker-dir*))
9.77+
9.78+(defvar *mbdb-worker-dir* (merge-pathnames ".import/" *mbdb-path*))
9.79+
9.80+(defvar *mbdump-files* nil) ;; set by MBDB-UNPACK
9.81+
9.82+(defvar *mbsamp-files* nil) ;; set by MBDB-UNPACK
9.83+
9.84+;;; Fetch Data
9.85+(defun mbdump-fetch ()
9.86+ "Download mbdump data pack."
9.87+ (unless (probe-file *mbdump-pack*)
9.88+ (download
9.89+ ;; (parse-uri
9.90+ *mbdump-pack-url*
9.91+ ;; )
9.92+ *mbdump-pack*)))
9.93+
9.94+(defun mbsamp-fetch ()
9.95+ (unless (probe-file *mbsamp-pack*)
9.96+ (download *mbsamp-pack-url* *mbsamp-pack*)))
9.97+
9.98+(defun mbsamp-unpack ()
9.99+ ;; unpack into mbsamp
9.100+ (let ((out-dir (merge-pathnames "mbsamp/" *mbdb-worker-dir*)))
9.101+ (unless (probe-file out-dir)
9.102+ (sb-ext:run-program "tar" `("-I" "zstd" "-xf" ,(namestring *mbsamp-pack*))
9.103+ :directory *mbdb-worker-dir*
9.104+ :search t
9.105+ :wait t))
9.106+ (setq *mbsamp-files* (directory "/tmp/mbdb/.import/mbsamp/*"))))
9.107+
9.108+(defun mbdump-unpack ()
9.109+ ;; unpack into mbsamp
9.110+ (let ((out-dir (merge-pathnames "mbdump/" *mbdb-worker-dir*)))
9.111+ (unless (probe-file out-dir)
9.112+ (sb-ext:run-program "tar" `("-I" "zstd" "-xf" ,(namestring *mbdump-pack*))
9.113+ :directory *mbdb-worker-dir*
9.114+ :search t
9.115+ :wait t))
9.116+ (setq *mbsamp-files* (directory "/tmp/mbdb/.import/mbdump/*"))))
9.117+
9.118+#+nil (extract-mbsamp (car (mbsamp-fetch)))
9.119+
9.120+;;; Parsing
9.121+(define-constant +mbsamp-null+ "\\N" :test #'string=)
9.122+
9.123+(defun nullable (str)
9.124+ (unless (string= +mbsamp-null+ str)
9.125+ (unless (= (length str) 0)
9.126+ str)))
9.127+
9.128+(defun proc-key (type)
9.129+ (case (sb-int:keywordicate type)
9.130+ (:id 'make-uuid-from-string)
9.131+ (:url 'parse-uri)
9.132+ (:num 'parse-integer)
9.133+ (:* 'nullable)
9.134+ (t 'identity)))
9.135+
9.136+(defun nullable-int (str)
9.137+ (parse-integer str :junk-allowed t))
9.138+
9.139+(defun nullable-int* (str)
9.140+ (or (ignore-errors
9.141+ (parse-integer str :junk-allowed t))
9.142+ (nullable str)))
9.143+
9.144+(defun nullable-time (str)
9.145+ (obj/time:parse-timestring str :date-time-separator #\Space :fail-on-error nil))
9.146+
9.147+(defun nullable-uri (str)
9.148+ (or
9.149+ (ignore-errors
9.150+ (parse-uri str :escape nil))
9.151+ (nullable str)))
9.152+
9.153+(defun mbsamp-schema (name &rest list)
9.154+ (cons name list))
9.155
9.156-(defun extract-columns (obj)
9.157- "Extract fields from a JSON-OBJECT, returning a vector of
9.158- uninitialized column-families which can be created with CREATE-CFS.
9.159+(defvar *mbsamp-schema-table*
9.160+ (let ((tbl (make-hash-table :test #'equal)))
9.161+ (mapc (lambda (x)
9.162+ (setf (gethash (car x) tbl) (cdr x)))
9.163+ (list
9.164+ (mbsamp-schema
9.165+ "alternative_release_type"
9.166+ #'parse-integer nil #'nullable #'parse-integer nil #'make-uuid-from-string)
9.167+ (mbsamp-schema
9.168+ "artist"
9.169+ #'parse-integer #'make-uuid-from-string nil nil
9.170+ #'nullable-int #'nullable #'nullable #'nullable #'nullable #'nullable
9.171+ #'nullable-int #'nullable-int #'nullable nil #'parse-integer
9.172+ #'nullable-time #'nullable-int #'nullable-int #'nullable)
9.173+ (mbsamp-schema
9.174+ "track"
9.175+ #'parse-integer #'make-uuid-from-string #'parse-integer #'parse-integer
9.176+ #'parse-integer #'nullable-int* nil #'parse-integer #'nullable-int
9.177+ #'parse-integer #'nullable-time #'parse-integer)
9.178+ (mbsamp-schema
9.179+ "recording"
9.180+ #'parse-integer #'make-uuid-from-string nil #'parse-integer
9.181+ #'nullable-int #'nullable-int* #'parse-integer #'nullable-time #'parse-integer)
9.182+ (mbsamp-schema
9.183+ "release"
9.184+ #'parse-integer #'make-uuid-from-string nil nil nil nil nil nil nil nil nil nil nil #'nullable-time)
9.185+ ;; (mbsamp-schema
9.186+ ;; "url"
9.187+ ;; #'parse-integer #'make-uuid-from-string #'nullable-uri #'parse-integer #'nullable-time)
9.188+ (mbsamp-schema
9.189+ "url" ;; 2,3
9.190+ #'parse-integer #'make-uuid-from-string #'nullable-uri nil nil)
9.191+ (mbsamp-schema
9.192+ "url_gid_redirect"
9.193+ #'make-uuid-from-string #'parse-integer #'nullable-time)
9.194+ (mbsamp-schema
9.195+ "tag"
9.196+ #'parse-integer nil #'parse-integer)
9.197+ (mbsamp-schema
9.198+ "genre"
9.199+ #'parse-integer #'make-uuid-from-string nil nil #'parse-integer #'nullable-time)
9.200+ (mbsamp-schema
9.201+ "work"
9.202+ #'parse-integer #'make-uuid-from-string nil #'nullable-int nil #'parse-integer #'nullable-time)
9.203+ (mbsamp-schema
9.204+ "instrument"
9.205+ #'parse-integer #'make-uuid-from-string nil #'nullable-int #'parse-integer #'nullable-time nil nil)
9.206+ ))
9.207+ tbl)
9.208+ "A Hashtable containing the various MusicBrainz table schemas of interest.")
9.209+
9.210+(defun get-schema (schema) (gethash schema *mbsamp-schema-table*))
9.211+
9.212+(defun extract-mbsamp (schema)
9.213+ "Extract the contents of FILE which is assumed to contain Tab-separated
9.214+values. Return a 2d array of row(values)."
9.215+ (let ((file (find schema *mbsamp-files* :test #'string= :key #'pathname-name))
9.216+ (map-fns (gethash schema *mbsamp-schema-table*)))
9.217+ (when file
9.218+ (dat/csv:read-csv-file file :header nil :delimiter #\Tab :map-fns map-fns))))
9.219+
9.220+(defun extract-mbdump-file (file)
9.221+ "Extract the contents of a json-dump FILE. Return a json-object."
9.222+ (with-open-file (f file)
9.223+ ;; (sb-impl::with-array-data
9.224+ (loop for x = (json-read f nil)
9.225+ while x
9.226+ collect x)))
9.227+
9.228+(defmacro with-mbsamp-proc (table shape &body vals)
9.229+ (with-gensyms (row i)
9.230+ `(coerce
9.231+ (loop for ,row across ,table
9.232+ for ,i below (length ,table)
9.233+ collect (make-array
9.234+ ,shape
9.235+ :initial-contents
9.236+ (list
9.237+ ,@(mapcar
9.238+ (lambda (v) `(aref ,row ,v))
9.239+ vals))))
9.240+ 'vector)))
9.241+
9.242+(defmacro def-mbsamp-proc (name &rest vals)
9.243+ (with-gensyms (table)
9.244+ (let ((fn-name (symbolicate "PROC-MBSAMP-" name)))
9.245+ `(defun ,fn-name (,table)
9.246+ ,(format nil "Process rows of ~A mbsamp data." name)
9.247+ (with-mbsamp-proc ,table ,(length vals) ,@vals)))))
9.248+
9.249+(defvar *mbsamp-cfs*
9.250+ (vector (make-rdb-cf "url")
9.251+ (make-rdb-cf "genre")
9.252+ (make-rdb-cf "tag")
9.253+ (make-rdb-cf "track")
9.254+ (make-rdb-cf "artist")
9.255+ (make-rdb-cf "work")
9.256+ (make-rdb-cf "recording")
9.257+ (make-rdb-cf "release")
9.258+ (make-rdb-cf "instrument")))
9.259+
9.260+(def-mbsamp-proc url 0 1 2)
9.261+(def-mbsamp-proc genre 0 1 2)
9.262+(def-mbsamp-proc tag 0 1 2)
9.263+(def-mbsamp-proc track 0 1 6)
9.264+(def-mbsamp-proc artist 0 1 2)
9.265+(def-mbsamp-proc work 0 1 4 6)
9.266+(def-mbsamp-proc recording 0 1 2 7)
9.267+(def-mbsamp-proc release 0 1 2 13)
9.268+(def-mbsamp-proc instrument 0 1 2 5 7)
9.269+
9.270+(defun extract-mbdump-columns (obj)
9.271+ "Extract fields from a json-object, returning a vector of
9.272+ uninitialized column-families which can be created with #'create-cfs.
9.273
9.274 Returns multiple values: the list of columns, the id, and type-id if present."
9.275 (values
9.276- (mapcar #'car (json-object-members obj))
9.277+ (mapcar (lambda (x) (make-rdb-cf (car x))) (json-object-members obj))
9.278 (make-uuid-from-string (json-getf obj "id"))
9.279 (when-let ((tid (json-getf obj "type-id")))
9.280 (make-uuid-from-string tid))))
9.281
9.282+;;; Tasks
9.283+(defvar *mbdb-buffer-size* 4096)
9.284+
9.285+(defclass mbdb-task (task) ())
9.286+
9.287+;;; Main
9.288 (defmain ()
9.289- (let ((*default-pathname-defaults* (ensure-directories-exist *mbdb-path* :verbose t)))
9.290+ (let ((*default-pathname-defaults* *mbdb-path*)
9.291+ (*progress-bar-enabled* t)
9.292+ (*csv-separator* #\Tab)
9.293+ (*cpus* (num-cpus))
9.294+ (*log-timestamp* nil)
9.295+ (*log-level* :warn))
9.296 (log:info! "Welcome to MBDB")
9.297+ (ensure-directories-exist *mbdb-worker-dir* :verbose t)
9.298+ ;; prepare workers
9.299+ (setf *mbdb-oracle* (make-oracle sb-thread:*current-thread*)
9.300+ *mbdb-tasks* (make-task-pool :oracle *mbdb-oracle*))
9.301+ (push-worker (sb-thread:make-thread #'mbsamp-fetch) *mbdb-tasks*)
9.302+ ;; (with-tasks ())
9.303+ (let ((job (make-job)))
9.304+ (push-task (make-instance 'mbdb-task :object #'mbsamp-fetch) job))
9.305+
9.306+ ;; (sb-thread:make-thread #'mbsamp-fetch)
9.307+
9.308+ ;; prepare column family data
9.309+
9.310+ ;; initialize database
9.311 (with-db (db *mbdb*)
9.312 (open-db db)
9.313- (close-db db))))
9.314+ (setf (rdb-cfs db) *mbsamp-cfs*)
9.315+ ;; (create-cfs db)
9.316+ (log:info! "database initialized")
9.317+ ;;
9.318+ (close-db db))
9.319+
9.320+ ;; launch tasks
9.321+
9.322+ ;; wait
9.323+ (wait-for-threads (task-pool-workers *mbdb-tasks*))
9.324+ ;; summarize
9.325+ (info! "mbdb stats" (print-stats *mbdb*))
9.326+ ;; close
9.327+ ))
10.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2+++ b/examples/db/readme.txt Sun Apr 14 20:48:05 2024 -0400
10.3@@ -0,0 +1,1 @@
10.4+This directory contains database examples.
11.1--- a/examples/examples.asd Thu Apr 11 18:58:35 2024 -0400
11.2+++ b/examples/examples.asd Sun Apr 14 20:48:05 2024 -0400
11.3@@ -1,10 +1,17 @@
11.4 (defsystem :examples
11.5 :depends-on (:prelude)
11.6 :components
11.7- ((:file "vegadat")
11.8+ ((:module "clos"
11.9+ :components ((:file "pkg")
11.10+ (:file "sealed")
11.11+ (:file "stealth")
11.12+ ;; (:file "fast-def")
11.13+ ;; (:file "fast")
11.14+ (:file "filtered")))
11.15+ (:file "vegadat")
11.16 (:module "db"
11.17 :components ((:file "cl-simple-example-raw")
11.18 (:file "mini-redis")
11.19 (:file "tao")
11.20- (:file "mbdb" :depends-on nil)))))
11.21+ (:file "mbdb")))))
11.22
12.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
12.2+++ b/tools/woo-bench.sh Sun Apr 14 20:48:05 2024 -0400
12.3@@ -0,0 +1,26 @@
12.4+#!/bin/sh
12.5+
12.6+BENCHMARK_DIR=$(dirname $0)
12.7+
12.8+REPEAT=${REPEAT:-3}
12.9+SERVER_PORT=${SERVER_PORT:-5000}
12.10+THREADS=${THREADS:-4}
12.11+CONNECTIONS=${CONNECTIONS:-10}
12.12+
12.13+echo "$ $@"
12.14+$@ >>"$BENCHMARK_DIR/benchmark.log" 2>&1 &
12.15+SERVER_PID=$!
12.16+
12.17+while true; do
12.18+ nc -z 127.0.0.1 $SERVER_PORT >/dev/null 2>&1 && break
12.19+ sleep 1
12.20+done
12.21+
12.22+echo "Started a server ($@) at $SERVER_PID."
12.23+
12.24+for i in `seq 1 $REPEAT`; do
12.25+ echo "\nRunning wrk ($i/$REPEAT)..."
12.26+ wrk -c "$CONNECTIONS" -t "$THREADS" -d 10 "http://127.0.0.1:$SERVER_PORT"
12.27+done
12.28+
12.29+kill "$SERVER_PID"
