1.1--- a/lisp/lib/dat/dat.asd Thu Aug 01 21:21:07 2024 -0400
1.2+++ b/lisp/lib/dat/dat.asd Sat Aug 03 00:59:36 2024 -0400
1.3@@ -1,6 +1,6 @@
1.4 (defsystem :dat
1.5 :description "Data formats"
1.6- :depends-on (:cl-ppcre :std :obj #+png :png :flexi-streams :io)
1.7+ :depends-on (:cl-ppcre :std :obj #+png :png :flexi-streams :io :log)
1.8 :version "0.1.0"
1.9 :serial t
1.10 :components ((:file "pkg")
2.1--- a/lisp/lib/obj/hash/chash.lisp Thu Aug 01 21:21:07 2024 -0400
2.2+++ b/lisp/lib/obj/hash/chash.lisp Sat Aug 03 00:59:36 2024 -0400
2.3@@ -51,3 +51,70 @@
2.4
2.5 ;;; Code:
2.6 (in-package :obj/hash)
2.7+
2.8+(deftype solist-element-designator () `(member ,@(list :addr :fixnum :string)))
2.9+
2.10+(defun show-list (solist)
2.11+ (let ((node (so-head solist)))
2.12+ (loop (format t "~s~%" node)
2.13+ (when (endp node) (return))
2.14+ (setq node (%node-next node)))))
2.15+
2.16+(defun show-bin (solist i)
2.17+ (let ((node (aref (car (so-bins solist)) i))
2.18+ (bin-nbits (- +hash-nbits+ (cdr (so-bins solist))))
2.19+ (count 0))
2.20+ (flet ((bit-string (hash)
2.21+ (let ((s (format nil " ~v,'0b" +hash-nbits+ hash)))
2.22+ (replace s s :end1 bin-nbits :start2 1)
2.23+ (setf (char s bin-nbits) #\.)
2.24+ s)))
2.25+ (cond
2.26+ ((unbound-marker-p node)
2.27+ (values 0 0))
2.28+ (t
2.29+ (let ((node node))
2.30+ (loop (let ((next (get-next node)))
2.31+ (when (or (endp next) (evenp (node-hash next)))
2.32+ (return))
2.33+ (incf count)
2.34+ (setq node next))))
2.35+ (format t " ~5d [~2d] = ~a" i count (bit-string (node-hash node)))
2.36+ (loop (let ((next (get-next node)))
2.37+ (when (or (endp next) (evenp (node-hash next)))
2.38+ (return))
2.39+ (setq node next)
2.40+ (if (= count 1)
2.41+ (format t " ~a=~s"
2.42+ (bit-string (node-hash node)) (so-key node))
2.43+ (format t "~% ~a=~s"
2.44+ (bit-string (node-hash node)) (so-key node)))))
2.45+ (terpri)
2.46+ (values 1 count))))))
2.47+
2.48+(defun show-bins (solist)
2.49+ (let ((bins (car (so-bins solist)))
2.50+ (bin-nbits (- +hash-nbits+ (cdr (so-bins solist))))
2.51+ (n-occupied-bins 0)
2.52+ (sum-chainlengths 0)
2.53+ (max-chainlength 0))
2.54+ (assert (= (length bins) (ash 1 bin-nbits)))
2.55+ (format t "Bins (~d total, ~d leading bits):~%"
2.56+ (length bins) bin-nbits)
2.57+ (dotimes (i (length bins))
2.58+ (multiple-value-bind (occupied count) (show-bin solist i)
2.59+ (incf n-occupied-bins occupied)
2.60+ (incf sum-chainlengths count)
2.61+ (setq max-chainlength (max count max-chainlength))))
2.62+ (let ((avg-chainlength (/ sum-chainlengths n-occupied-bins)))
2.63+ (format t "~&Total ~D items, avg ~F items/bin~%"
2.64+ (so-count solist) avg-chainlength)
2.65+ (values max-chainlength (float avg-chainlength)))))
2.66+
2.67+(defun print-hashes (solist)
2.68+ (do ((node (%node-next (so-head solist)) (%node-next node)))
2.69+ ((endp node))
2.70+ (format t "~16x~@[ ~s~]~%"
2.71+ (node-hash node)
2.72+ (if (so-key-node-p node) (type-of (so-key node))))))
2.73+(sb-lockless:lfl-insert (sb-lockless:make-ordered-list :key-type 'fixnum) 5 'five)
3.1--- a/lisp/lib/obj/hash/map.lisp Thu Aug 01 21:21:07 2024 -0400
3.2+++ b/lisp/lib/obj/hash/map.lisp Sat Aug 03 00:59:36 2024 -0400
3.3@@ -4,3 +4,15 @@
3.4
3.5 ;;; Code:
3.6 (in-package :obj/hash)
3.7+
3.8+;;; SOLIST
3.9+
3.10+;; Lockfree Maps
3.11+
3.12+(defmacro make-so-map (&optional (type :addr))
3.13+ "Return a SOLIST map. Type may be either FIXNUM or STRING."
3.14+ (declare (solist-element-designator type))
3.15+ `(case ,type
3.16+ (:fixnum ,(make-so-map/fixnum))
3.17+ (:string ,(make-so-map/string))
3.18+ (:addr ,(make-so-map/addr))))
4.1--- a/lisp/lib/obj/hash/set.lisp Thu Aug 01 21:21:07 2024 -0400
4.2+++ b/lisp/lib/obj/hash/set.lisp Sat Aug 03 00:59:36 2024 -0400
4.3@@ -7,6 +7,14 @@
4.4
4.5 ;;; SOLIST
4.6
4.7-;; Split-Ordered Lists
4.8+;; Lockfree hashsets
4.9
4.10 ;; see file src/code/solist.lisp
4.11+
4.12+(defmacro make-so-set (&optional (type :addr))
4.13+ "Return a SOLIST set. Type is of type SOLIST-ELEMENT-DESIGNATOR."
4.14+ (declare (solist-element-designator type))
4.15+ `(case ,type
4.16+ (:fixnum ,(make-so-set/fixnum))
4.17+ (:string ,(make-so-map/string))
4.18+ (:addr ,(make-so-set/addr))))
5.1--- a/lisp/lib/obj/list/clist.lisp Thu Aug 01 21:21:07 2024 -0400
5.2+++ b/lisp/lib/obj/list/clist.lisp Sat Aug 03 00:59:36 2024 -0400
5.3@@ -1,7 +1,7 @@
5.4 ;;; obj/list/clist.lisp --- Concurrent Lists
5.5
5.6 ;; https://timharris.uk/papers/2001-disc.pdf
5.7-;; see sb-lockless - lfl=lockfree-list solist=splitorder-lists
5.8+;; see sb-lockless - lfl=lockfree-list
5.9
5.10 ;;; Code:
5.11 (in-package :obj/list)
6.1--- a/lisp/lib/obj/pkg.lisp Thu Aug 01 21:21:07 2024 -0400
6.2+++ b/lisp/lib/obj/pkg.lisp Sat Aug 03 00:59:36 2024 -0400
6.3@@ -23,8 +23,11 @@
6.4 (defpackage :obj/hash
6.5 (:nicknames :hash)
6.6 (:use :cl :std)
6.7+ (:shadowing-import-from :sb-lockless :endp)
6.8 (:import-from :sb-lockless
6.9 :make-so-map/fixnum :+hash-nbits+
6.10+ :node-hash :%node-next
6.11+ :unbound-marker-p
6.12 :get-next :node-hash
6.13 :so-head :so-bins
6.14 :so-key :so-data
6.15@@ -32,7 +35,8 @@
6.16 :so-insert :so-delete
6.17 :so-find :so-find/string
6.18 :so-maplist :make-so-map/string
6.19- :make-so-set/string :make-so-map/addr :make-marked-ref)
6.20+ :make-so-set/string :make-so-set/fixnum :make-so-map/addr :make-marked-ref
6.21+ :make-so-set/addr)
6.22 (:export
6.23 :*global-hasher*
6.24 :*global-hash*
7.1--- a/lisp/lib/obj/query.lisp Thu Aug 01 21:21:07 2024 -0400
7.2+++ b/lisp/lib/obj/query.lisp Sat Aug 03 00:59:36 2024 -0400
7.3@@ -21,6 +21,14 @@
7.4 ;; - Backends :: The interface exposed to the underlying data sources -
7.5 ;; RocksDB, SQLite, etc.
7.6
7.7+;;;; Refs
7.8+
7.9+;; https://gist.github.com/twitu/221c8349887cec0a83b395e4cbb492a7
7.10+
7.11+;; https://www1.columbia.edu/sec/acis/db2/db2d0/db2d0103.htm
7.12+
7.13+;; https://howqueryengineswork.com/
7.14+
7.15 ;;; Code:
7.16 (in-package :obj/query)
7.17
7.18@@ -353,9 +361,9 @@
7.19
7.20 ;;;;; Scan
7.21 (defclass scan-data (logical-plan)
7.22- ((path :type string)
7.23- (data-source :type data-source)
7.24- (projection :type (vector string))))
7.25+ ((path :type string :initarg :path)
7.26+ (data-source :type data-source :initarg :data-source)
7.27+ (projection :type (vector string) :initarg :projection)))
7.28
7.29 (defmethod derive-schema ((self scan-data))
7.30 (let ((proj (slot-value self 'projection)))
7.31@@ -368,25 +376,25 @@
7.32
7.33 ;;;;; Projection
7.34 (defclass projection (logical-plan)
7.35- ((input :type logical-plan)
7.36- (expr :type (vector logical-expression))))
7.37+ ((input :type logical-plan :initarg :input)
7.38+ (expr :type (vector logical-expression) :initarg :expr)))
7.39
7.40 (defmethod schema ((self projection))
7.41 (schema (slot-value self 'input)))
7.42
7.43 ;;;;; Selection
7.44 (defclass selection (logical-plan)
7.45- ((input :type logical-plan)
7.46- (expr :type logical-expression)))
7.47+ ((input :type logical-plan :initarg :input)
7.48+ (expr :type logical-expression :initarg :expr)))
7.49
7.50 (defmethod schema ((self selection))
7.51 (schema (slot-value self 'input)))
7.52
7.53 ;;;;; Aggregate
7.54 (defclass aggregate (logical-plan)
7.55- ((input :type logical-plan)
7.56- (group-expr :type (vector logical-expression))
7.57- (agg-expr :type (vector aggregate-expression))))
7.58+ ((input :type logical-plan :initarg :input)
7.59+ (group-expr :type (vector logical-expression) :initarg :group-expr)
7.60+ (agg-expr :type (vector aggregate-expression) :initarg :agg-expr)))
7.61
7.62 (defmethod schema ((self aggregate))
7.63 (let ((input (slot-value self 'input))
7.64@@ -398,7 +406,6 @@
7.65 (make-schema :fields (coerce ret 'field-vector))))
7.66
7.67 ;;; Physical Expression
7.68-
7.69 (defclass physical-expression (query-expression) ())
7.70
7.71 (defclass literal-physical-expression (physical-expression) ())
7.72@@ -439,6 +446,24 @@
7.73 (declare (ignore self))
7.74 (equal lhs rhs))
7.75
7.76+(defclass neq-physical-expression (binary-physical-expression) ())
7.77+
7.78+(defmethod evaluate2 ((self neq-physical-expression) lhs rhs)
7.79+ (declare (ignore self))
7.80+ (equal lhs rhs))
7.81+
7.82+(defclass lt-physical-expression (binary-physical-expression) ())
7.83+
7.84+(defclass gt-physical-expression (binary-physical-expression) ())
7.85+
7.86+(defclass lteq-physical-expression (binary-physical-expression) ())
7.87+
7.88+(defclass gteq-physical-expression (binary-physical-expression) ())
7.89+
7.90+(defclass and-physical-expression (binary-physical-expression) ())
7.91+
7.92+(defclass or-physical-expression (binary-physical-expression) ())
7.93+
7.94 (defclass math-physical-expression (binary-physical-expression) ())
7.95
7.96 (defmethod evaluate2 ((self math-physical-expression) (lhs column-vector) (rhs column-vector))
7.97@@ -452,6 +477,24 @@
7.98 (declare (ignore self))
7.99 (+ lhs rhs))
7.100
7.101+(defclass sub-physical-expression (math-expression) ())
7.102+
7.103+(defmethod evaluate2 ((self sub-physical-expression) lhs rhs)
7.104+ (declare (ignore self))
7.105+ (- lhs rhs))
7.106+
7.107+(defclass mult-physical-expression (math-expression) ())
7.108+
7.109+(defmethod evaluate2 ((self mult-physical-expression) lhs rhs)
7.110+ (declare (ignore self))
7.111+ (* lhs rhs))
7.112+
7.113+(defclass div-physical-expression (math-expression) ())
7.114+
7.115+(defmethod evaluate2 ((self div-physical-expression) lhs rhs)
7.116+ (declare (ignore self))
7.117+ (/ lhs rhs))
7.118+
7.119 (defclass accumulator ()
7.120 ((value :initarg :value :accessor accumulator-value)))
7.121
7.122@@ -523,7 +566,6 @@
7.123 collect (make-record-batch :schema schema :fields (coerce filtered 'field-vector)))
7.124 '(vector record-batch)))
7.125
7.126-;; NOTE 2024-07-10:
7.127 (defgeneric filter (self columns selection)
7.128 (:method ((self selection-exec) (columns column-vector) (selection simple-bit-vector))
7.129 (coerce
7.130@@ -533,9 +575,9 @@
7.131 'field-vector)))
7.132
7.133 (defclass hash-aggregate-exec (physical-plan)
7.134- ((input :type physical-plan)
7.135- (group-expr :type (vector physical-plan))
7.136- (agg-expr :type (vector aggregate-physical-expression))))
7.137+ ((input :type physical-plan :initarg :input)
7.138+ (group-expr :type (vector physical-plan) :initarg :group-expr)
7.139+ (agg-expr :type (vector aggregate-physical-expression) :initarg :agg-expr)))
7.140
7.141 (defmethod execute ((self hash-aggregate-exec))
7.142 (coerce
7.143@@ -589,7 +631,6 @@
7.144
7.145 (defclass query-planner () ())
7.146
7.147-;; these generics
7.148 (defgeneric make-physical-expression (expr input)
7.149 (:documentation "Translate logical expression EXPR and logical plan INPUT
7.150 into a physical expression.")
7.151@@ -607,18 +648,17 @@
7.152 (r (make-physical-expression (rhs expr) input)))
7.153 (etypecase expr
7.154 (eq-expression (make-instance 'eq-physical-expression :lhs l :rhs r))
7.155- ;; (neq-expression (make-instance 'neq-physical-expression :lhs l :rhs r))
7.156- ;; (gt-expression)
7.157- ;; (gteq-expression)
7.158- ;; (lt-expression)
7.159- ;; (lteq-expression)
7.160- ;; (and-expression)
7.161- ;; (or-expression)
7.162+ (neq-expression (make-instance 'neq-physical-expression :lhs l :rhs r))
7.163+ (gt-expression (make-instance 'gt-physical-expression :lhs l :rhs r))
7.164+ (gteq-expression (make-instance 'gteq-physical-expression :lhs l :rhs r))
7.165+ (lt-expression (make-instance 'lt-physical-expression :lhs l :rhs r))
7.166+ (lteq-expression (make-instance 'lteq-physical-expression :lhs l :rhs r))
7.167+ (and-expression (make-instance 'and-physical-expression :lhs l :rhs r))
7.168+ (or-expression (make-instance 'or-physical-expression :lhs l :rhs r))
7.169 (add-expression (make-instance 'add-physical-expresion :lhs l :rhs r))
7.170- ;; (sub-expression)
7.171- ;; (mult-expression)
7.172- ;; (div-expression)
7.173- ))))
7.174+ (sub-expression (make-instance 'sub-physical-expression :lhs l :rhs r))
7.175+ (mult-expression (make-instance 'mult-physical-expression :lhs l :rhs r))
7.176+ (div-expression (make-instance 'div-physical-expression :lhs l :rhs r))))))
7.177
7.178 (defgeneric make-physical-plan (plan)
7.179 (:documentation "Create a physical plan from logical PLAN.")
7.180@@ -639,8 +679,42 @@
7.181 (selection (make-instance 'selection-exec
7.182 :input (make-physical-plan (slot-value plan 'input))
7.183 :expr (make-physical-expression (slot-value plan 'expr) (slot-value plan 'input))))
7.184- ;; TODO 2024-07-10:
7.185- (aggregate (make-instance 'hash-aggregate-exec)))))
7.186+ (aggregate (make-instance 'hash-aggregate-exec
7.187+ :input (make-physical-plan (slot-value plan 'input))
7.188+ :group-expr (make-physical-expression (slot-value plan 'group-expr) (slot-value plan 'input))
7.189+ :agg-expr (make-physical-expression (slot-value plan 'agg-expr) (slot-value plan 'input)))))))
7.190+
7.191+;;; Joins
7.192+
7.193+;; TODO 2024-08-02:
7.194+
7.195+;; inner-join
7.196+
7.197+;; outer-join left-outer-join right-outer-join
7.198+
7.199+;; semi-join
7.200+
7.201+;; anti-join
7.202+
7.203+;; cross-join
7.204+
7.205+;;; Subqueries
7.206+
7.207+;; TODO 2024-08-02:
7.208+
7.209+;; subquery
7.210+
7.211+;; correlated-subquery
7.212+
7.213+;; SELECT id, name, (SELECT count(*) FROM orders WHERE customer_id = customer.id) AS num_orders FROM customers
7.214+
7.215+;; uncorrelated-subquery
7.216+
7.217+;; scalar-subquery
7.218+
7.219+;; SELECT * FROM orders WHERE total > (SELECT avg(total) FROM sales WHERE customer_state = 'CA')
7.220+
7.221+;; NOTE 2024-08-02: EXISTS, IN, NOT EXISTS, and NOT IN are also subqueries
7.222
7.223 ;;; Optimizer
7.224
7.225@@ -654,7 +728,56 @@
7.226 ;; TODO 2024-07-10:
7.227 (defclass query-optimizer () ())
7.228
7.229-(defgeneric optimize-query (self &key &allow-other-keys))
7.230+(defstruct (query-vop (:constructor make-query-vop (info)))
7.231+ (info nil))
7.232+
7.233+(defgeneric optimize-query (self plan))
7.234+
7.235+;; Projection Pushdown
7.236+(defun extract-columns (expr input &optional accum)
7.237+ (etypecase expr
7.238+ (array-index (accumulate accum (field (fields (schema input)) expr)))
7.239+ (column-expression (accumulate accum (column-name expr)))
7.240+ (binary-expression
7.241+ (extract-columns (lhs expr) input accum)
7.242+ (extract-columns (rhs expr) input accum))
7.243+ (alias-expression (extract-columns (slot-value expr 'expr) input accum))
7.244+ ;; cast-expression
7.245+ (literal-expression nil)))
7.246+
7.247+(defun extract-columns* (exprs input &optional accum)
7.248+ (mapcar (lambda (x) (extract-columns x input accum)) exprs))
7.249+
7.250+(defclass projection-pushdown-optimizer (query-optimizer) ())
7.251+
7.252+(defun %pushdown (plan &optional column-names)
7.253+ (declare (logical-plan plan))
7.254+ (etypecase plan
7.255+ (projection
7.256+ (extract-columns (slot-value plan 'expr) column-names)
7.257+ (let ((input (%pushdown (slot-value plan 'input) column-names)))
7.258+ (make-instance 'projection :input input :expr (slot-value plan 'expr))))
7.259+ (selection
7.260+ (extract-columns (slot-value plan 'expr) column-names)
7.261+ (let ((input (%pushdown (slot-value plan 'input) column-names)))
7.262+ (make-instance 'selection :input input :expr (slot-value plan 'expr))))
7.263+ (aggregate
7.264+ (extract-columns (slot-value plan 'group-expr) column-names)
7.265+ (extract-columns*
7.266+ (loop for x across (slot-value plan 'agg-expr) collect (slot-value x 'input))
7.267+ column-names)
7.268+ (let ((input (%pushdown (slot-value plan 'input) column-names)))
7.269+ (make-instance 'aggregate
7.270+ :input input
7.271+ :group-expr (slot-value plan 'group-expr)
7.272+ :agg-expr (slot-value plan 'agg-expr))))
7.273+ (scan-data (make-instance 'scan-data
7.274+ :path (slot-value plan 'name)
7.275+ :data-source (slot-value plan 'data-source)
7.276+ :projection column-names)))) ;; maybe sort here?
7.277+
7.278+(defmethod optimize-query ((self projection-pushdown-optimizer) (plan logical-plan))
7.279+ (%pushdown plan))
7.280
7.281 ;;; Query
7.282 (defclass query () ())
8.1--- a/lisp/lib/obj/tests.lisp Thu Aug 01 21:21:07 2024 -0400
8.2+++ b/lisp/lib/obj/tests.lisp Sat Aug 03 00:59:36 2024 -0400
8.3@@ -250,6 +250,9 @@
8.4
8.5 (defclass bogus-data-source (data-source) ((db :initform nil :initarg :db)))
8.6
8.7-(deftest query-simple-hard ()
8.8+(defvar *basic-query* "SELECT * FROM employee WHERE state = 'CT'")
8.9+
8.10+(deftest query-basic ()
8.11 "Test the simple query `SELECT * FROM employee WHERE state = 'CT'` by manually
8.12-building a query-plan.")
8.13+building a query-plan."
8.14+ (make-query *basic-query*))
9.1--- a/lisp/lib/q/dql.lisp Thu Aug 01 21:21:07 2024 -0400
9.2+++ b/lisp/lib/q/dql.lisp Sat Aug 03 00:59:36 2024 -0400
9.3@@ -23,13 +23,42 @@
9.4
9.5 ;; The WAM compiler is a bit too much to understand let alone implement at
9.6 ;; this stage. The design of this package will be much simpler and optimized
9.7-;; for compatibility with Lisp.
9.8+;; for compatibility with Lisp Objects.
9.9+
9.10+;; I think we can get quite far, with a bit of clever hacking and some good
9.11+;; macros.
9.12+
9.13+;;;; Refs
9.14
9.15-;; I think we can get quite far
9.16+;; https://franz.com/support/documentation/11.0/prolog.html
9.17+
9.18+;; https://github.com/wmannis/cl-gambol
9.19+
9.20+;; https://norvig.com/paip/README.html
9.21+
9.22+;; https://en.wikipedia.org/wiki/Negation_as_failure
9.23
9.24 ;;; Code:
9.25 (in-package :q/dql)
9.26
9.27+;;; Vars
9.28+
9.29+(declaim (fixnum *lips*))
9.30+(defvar *lips* 0
9.31+ "Count of logical inferences performed.")
9.32+
9.33+;; from GAMBOL
9.34+(defvar *interactive* t "true iff interacting with user")
9.35+(defvar *auto-backtrack* nil "return all solutions if true")
9.36+(defvar *last-continuation* nil "saved state of the system")
9.37+(defvar *trail* nil "the trail, for backtracking")
9.38+(defvar *x-env* nil "env for goals")
9.39+(defvar *y-env* nil "env for rules")
9.40+(defvar *top-level-envs* nil "saves top-level environments")
9.41+(defvar *top-level-vars* nil "saves top-level variable names")
9.42+(defvar *num-slots* -1 "number of logical variables in a query")
9.43+(defvar *rules* (make-hash-table) "hash table for prolog rule heads")
9.44+
9.45 ;;; Conditions
9.46 (define-condition dql-error (error) ())
9.47
9.48@@ -38,8 +67,21 @@
9.49 (defun simple-dql-error (ctrl &rest args)
9.50 (error 'simpl-dql-error :format-control ctrl :format-arguments args))
9.51
9.52+;;; CLOS
9.53 (defclass dql-query (query) ())
9.54
9.55 (defclass dql-data-source (data-source) ()
9.56 (:documentation "Data source which can be used withing DQL expressions."))
9.57
9.58+;;; Prolog Semantics
9.59+
9.60+;; NOTE 2024-08-03: we're loosely following along with CL-GAMBOL, but sticking
9.61+;; with defstructs instead of vectors for the most part. I'm willing to pay
9.62+;; the immediate cost of not vectorizing in hopes that the fact that structs
9.63+;; are vector-backed and multi-threaded contexts exist will minimize the
9.64+;; effect.
9.65+
9.66+;;; Macros
9.67+(defmacro ?- (&body clauses))
9.68+
9.69+(defmacro *- (head &body body))
10.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2+++ b/lisp/lib/skel/core/print.lisp Sat Aug 03 00:59:36 2024 -0400
10.3@@ -0,0 +1,28 @@
10.4+;;; print.lisp --- Skel Printer
10.5+
10.6+;; SK-PRINT
10.7+
10.8+;;; Commentary:
10.9+
10.10+;; SK-PRINT is the top-level interface, and dispatches on all sorts of SKEL
10.11+;; objects. The output is different than the PRINT-OBJECT methods, which are
10.12+;; implemented in the SKEL/CORE/OBJ package.
10.13+
10.14+;; SK-PRINT is the 'external print' representation, which is structured, akin
10.15+;; to PPRINT - while PRINT-OBJECT is the 'internal print' and unstructured
10.16+;; representation.
10.17+
10.18+;; All printer parameters are dynamic and dispatch occurs in the same manner
10.19+;; as the standard Lisp Printer. Additional parameters may be provided in the
10.20+;; future.
10.21+
10.22+;;; Code:
10.23+(in-package :skel/core/print)
10.24+
10.25+;; sb-pretty::*standard-pprint-dispatch-table*
10.26+;; *readtable*
10.27+
10.28+(sb-ext:defglobal *sk-print-dispatch-table* (sb-pretty::make-pprint-dispatch-table #() nil nil))
10.29+
10.30+(defmethod sk-print ((self skel))
10.31+ (pprint (cons (keywordicate (class-name (class-of self))) (format-sxhash (obj/id:id self)))))
