1.1--- a/lisp/lib/obj/pkg.lisp Sun Aug 04 16:58:23 2024 -0400
1.2+++ b/lisp/lib/obj/pkg.lisp Sun Aug 04 20:51:07 2024 -0400
1.3@@ -437,7 +437,23 @@
1.4 :df-fields
1.5 :df-data
1.6 :limit
1.7- :make-df))
1.8+ :make-df
1.9+ :binary-expression-name
1.10+ :binary-expression-op
1.11+ :sum-expression
1.12+ :min-expression
1.13+ :max-expression
1.14+ :avg-expression
1.15+ :count-expression
1.16+ :to-field
1.17+ :column-name
1.18+ :cast-expression
1.19+ :df-plan
1.20+ :df-exec
1.21+ :execute*
1.22+ :register-file
1.23+ :register-data-source
1.24+ :register-df))
1.25
1.26 (defpackage :obj/secret
1.27 (:nicknames :secret)
2.1--- a/lisp/lib/obj/query.lisp Sun Aug 04 16:58:23 2024 -0400
2.2+++ b/lisp/lib/obj/query.lisp Sun Aug 04 20:51:07 2024 -0400
2.3@@ -162,9 +162,7 @@
2.4 (:method ((self record-batch))
2.5 (length (record-batch-fields self))))
2.6
2.7-;;; Execution Context
2.8-(defclass execution-context () ())
2.9-
2.10+;;; Data Source
2.11 (defclass data-source ()
2.12 ((schema :type schema :accessor schema)))
2.13
2.14@@ -212,6 +210,13 @@
2.15 ((expr :type logical-expression :initarg :expr :accessor expr)
2.16 (alias :type string :initarg :alias)))
2.17
2.18+(defclass cast-expression (logical-expression)
2.19+ ((expr :type logical-expression :initarg :expr :accessor expr)
2.20+ (data-type :type form :initarg :data-type)))
2.21+
2.22+(defmethod to-field ((self cast-expression) (input logical-plan))
2.23+ (make-field :name (field-name (to-field (expr self) input)) :type (slot-value self 'data-type)))
2.24+
2.25 ;;;;; Unary
2.26 (defclass unary-expression (logical-expression)
2.27 ((expr :type logical-expression :accessor expr)))
2.28@@ -502,10 +507,16 @@
2.29 (defmethod schema ((df data-frame))
2.30 (schema (data-frame-plan df)))
2.31
2.32+(defmethod (setf schema) ((schema schema) (df data-frame))
2.33+ (setf (schema df) schema))
2.34+
2.35 (defgeneric df-plan (df)
2.36 (:documentation "Return the logical plan associated with this data-frame.")
2.37 (:method ((df data-frame)) (data-frame-plan df)))
2.38
2.39+(defmethod (setf df-plan) ((plan logical-plan) (df data-frame))
2.40+ (setf (df-plan df) plan))
2.41+
2.42 ;;; Physical Expression
2.43 (defclass physical-expression (query-expression) ())
2.44
2.45@@ -602,7 +613,9 @@
2.46 (defgeneric accumulate (self val)
2.47 (:method ((self accumulator) val)
2.48 (when val
2.49- (setf (accumulator-value self) (+ val (accumulator-value self))))))
2.50+ (setf (accumulator-value self) (+ val (accumulator-value self)))))
2.51+ (:method ((self list) val)
2.52+ (push val self)))
2.53
2.54 (defgeneric make-accumulator (self))
2.55
2.56@@ -622,7 +635,10 @@
2.57 (make-instance 'max-accumulator))
2.58
2.59 ;;; Physical Plan
2.60-(defgeneric execute (self))
2.61+(defgeneric execute (self)
2.62+ (:documentation "Execute the LOGICAL-PLAN represented by object SELF.")
2.63+ (:method ((self data-frame))
2.64+ (execute (df-plan self))))
2.65
2.66 (defclass scan-exec (physical-plan)
2.67 ((data-source :type data-source :initarg :data-source)
2.68@@ -810,8 +826,8 @@
2.69 (binary-expression
2.70 (extract-columns (lhs expr) input accum)
2.71 (extract-columns (rhs expr) input accum))
2.72- (alias-expression (extract-columns (slot-value expr 'expr) input accum))
2.73- ;; cast-expression
2.74+ (alias-expression (extract-columns (expr expr) input accum))
2.75+ (cast-expression (extract-columns (expr expr) input accum))
2.76 (literal-expression nil)))
2.77
2.78 (defun extract-columns* (exprs input &optional accum)
2.79@@ -855,3 +871,26 @@
2.80 (:method ((self t) &rest initargs)
2.81 (declare (ignore initargs))
2.82 (make-instance 'query)))
2.83+
2.84+;;; Execution Context
2.85+(defclass execution-context () ())
2.86+
2.87+(defgeneric register-df (self name df)
2.88+ (:documentation "Register a DATA-FRAME with an EXECUTION-CONTEXT."))
2.89+
2.90+(defgeneric register-data-source (self name source)
2.91+ (:documentation "Register a DATA-SOURCE with an EXECUTION-CONTEXT."))
2.92+
2.93+(defgeneric register-file (self name path &key type &allow-other-keys)
2.94+ (:documentation "Register a DATA-SOURCE contained in a file of type TYPE at PATH."))
2.95+
2.96+(defgeneric execute* (self df)
2.97+ (:documentation "Execute the DATA-FRAME DF in CONTEXT.")
2.98+ (:method ((self execution-context) (df data-frame))
2.99+ (declare (ignore self))
2.100+ (execute df)))
2.101+
2.102+(defmethod execute ((self logical-plan))
2.103+ (execute
2.104+ (make-physical-plan
2.105+ (optimize-query (make-instance 'projection-pushdown-optimizer) self))))
3.1--- a/lisp/lib/q/engine.lisp Sun Aug 04 16:58:23 2024 -0400
3.2+++ b/lisp/lib/q/engine.lisp Sun Aug 04 20:51:07 2024 -0400
3.3@@ -10,5 +10,16 @@
3.4 ;;; Code:
3.5 (in-package :q/proto)
3.6
3.7-(defclass query-engine (query-planner query-optimizer execution-context)
3.8- ((data-sources)))
3.9+;;; Vars
3.10+(defvar *query-engine*)
3.11+(deftype query-dialect-designator () `(member :sql :dql))
3.12+(declaim (query-dialect-designator *query-dialect*))
3.13+(defvar *query-dialect* :sql)
3.14+
3.15+;;; Engine
3.16+;; NOTE 2024-08-04: only slot inherited should be :SCHEMA from DATA-SOURCE. A
3.17+;; QUERY-ENGINE may always act as a source for another engine.
3.18+(defclass query-engine (query-planner execution-context data-source)
3.19+ ((sources :initarg :sources)
3.20+ (parser :initarg :parser :type query-parser)
3.21+ (optimizer :initarg :optimizer :type query-optimizer)))
4.1--- a/lisp/lib/q/pkg.lisp Sun Aug 04 16:58:23 2024 -0400
4.2+++ b/lisp/lib/q/pkg.lisp Sun Aug 04 20:51:07 2024 -0400
4.3@@ -6,7 +6,10 @@
4.4 (defpackage :q/proto
4.5 (:use :cl :std :obj/query :obj/id)
4.6 (:export
4.7- :query-engine :query-parser))
4.8+ :query-engine :query-parser
4.9+ :*query-engine*
4.10+ :*query-dialect*
4.11+ :query-dialect-designator))
4.12
4.13 (defpackage :q/sql
4.14 (:nicknames :sql)
4.15@@ -51,7 +54,8 @@
4.16 :sql-binary-expression
4.17 :with-sql-stream
4.18 :with-sql-string
4.19- :with-sql))
4.20+ :with-sql
4.21+ :make-sql-data-frame))
4.22
4.23 (defpackage :q/dql
4.24 (:nicknames :dql)
5.1--- a/lisp/lib/q/q.asd Sun Aug 04 16:58:23 2024 -0400
5.2+++ b/lisp/lib/q/q.asd Sun Aug 04 20:51:07 2024 -0400
5.3@@ -11,5 +11,8 @@
5.4
5.5 (defsystem :q/tests
5.6 :depends-on (:std :rt :q :log)
5.7- :components ((:file "tests"))
5.8+ :components ((:module "tests"
5.9+ :components ((:file "pkg")
5.10+ (:file "fuzz")
5.11+ (:file "suite"))))
5.12 :in-order-to ((test-op (test-op "q/tests"))))
6.1--- a/lisp/lib/q/sql.lisp Sun Aug 04 16:58:23 2024 -0400
6.2+++ b/lisp/lib/q/sql.lisp Sun Aug 04 20:51:07 2024 -0400
6.3@@ -55,10 +55,10 @@
6.4 ((op :initarg :op :type symbol :accessor binary-expression-op)))
6.5
6.6 (defclass sql-string (sql-expression literal-expression)
6.7- ((value :type string :initarg :value)))
6.8+ ((value :type string :initarg :value :accessor literal-value)))
6.9
6.10 (defclass sql-number (sql-expression literal-expression)
6.11- ((value :type number :initarg :value)))
6.12+ ((value :type number :initarg :value :accessor literal-value)))
6.13
6.14 (defclass sql-function (id sql-expression)
6.15 ((args :type sql-expression-vector :initarg :args)))
6.16@@ -667,20 +667,139 @@
6.17 ,@body))
6.18
6.19 ;;; Planner
6.20-(defclass sql-logical-plan (logical-plan) ())
6.21-(defclass sql-physical-plan (physical-plan) ())
6.22-
6.23-(defmethod make-physical-expression ((expr sql-expression) (input sql-logical-plan)))
6.24-(defmethod make-physical-plan ((plan sql-logical-plan)))
6.25-
6.26 (defclass sql-planner (query-planner) ())
6.27
6.28-(defun make-sql-logical-expression ())
6.29-(defun get-ref-columns ())
6.30-(defun get-selection-ref-columns ())
6.31-(defun plan-non-aggregate-query ())
6.32-(defun plan-aggregate-query ())
6.33+(defun make-sql-logical-expression (expr input)
6.34+ (etypecase expr
6.35+ (sql-identifier (make-instance 'column-expression :name (id expr)))
6.36+ (sql-string (literal-value expr))
6.37+ (sql-number (literal-value expr))
6.38+ ;; TODO 2024-08-04: sql-unary-expression
6.39+ (sql-binary-expression
6.40+ (let ((l (make-sql-logical-expression (lhs expr) input))
6.41+ (r (make-sql-logical-expression (rhs expr) input)))
6.42+ (etypecase expr
6.43+ (sql-math-expression
6.44+ (string-case ((binary-expression-op expr))
6.45+ ;; equiv ops
6.46+ ("=" (make-instance 'eq-expression :lhs l :rhs r))
6.47+ ("!=" (make-instance 'neq-expression :lhs l :rhs r))
6.48+ (">" (make-instance 'gt-expression :lhs l :rhs r))
6.49+ (">=" (make-instance 'gteq-expression :lhs l :rhs r))
6.50+ ("<" (make-instance 'lt-expression :lhs l :rhs r))
6.51+ ("<=" (make-instance 'lteq-expression :lhs l :rhs r))
6.52+ ;; boolean ops
6.53+ ("AND" (make-instance 'and-expression :lhs l :rhs r))
6.54+ ("OR" (make-instance 'or-expression :lhs l :rhs r))
6.55+ ;; math ops
6.56+ ("+" (make-instance 'add-expression :lhs l :rhs r))
6.57+ ("-" (make-instance 'sub-expression :lhs l :rhs r))
6.58+ ("*" (make-instance 'mult-expression :lhs l :rhs r))
6.59+ ("/" (make-instance 'div-expression :lhs l :rhs r))
6.60+ ("%" (make-instance 'mod-expression :lhs l :rhs r)))))))
6.61+ (sql-alias (make-instance 'alias-expression
6.62+ :expr (make-sql-logical-expression (slot-value expr 'expr) input)
6.63+ :alias (id (slot-value expr 'alias))))
6.64+ ;; TODO 2024-08-04: requires cast-expression impl in obj/query
6.65+ ;; (sql-cast (make-instance 'cast))
6.66+ (sql-function
6.67+ (when (id expr)
6.68+ (string-case ((id expr))
6.69+ ("MIN" (make-instance 'min-expression
6.70+ :expr (make-sql-logical-expression (car (slot-value expr 'args)) input)))
6.71+ ("MAX" (make-instance 'max-expression
6.72+ :expr (make-sql-logical-expression (car (slot-value expr 'args)) input)))
6.73+ ("SUM" (make-instance 'sum-expression
6.74+ :expr (make-sql-logical-expression (car (slot-value expr 'args)) input)))
6.75+ ("AVG" (make-instance 'avg-expression
6.76+ :expr (make-sql-logical-expression (car (slot-value expr 'args)) input))))))))
6.77+
6.78+(labels ((visit (expr accum)
6.79+ (when expr
6.80+ (typecase expr
6.81+ (column-expression (accumulate accum (column-name expr)))
6.82+ (alias-expression (visit (slot-value expr 'expr) accum))
6.83+ (binary-expression
6.84+ (visit (lhs expr) accum)
6.85+ (visit (rhs expr) accum))
6.86+ (aggregate-expression (visit (slot-value expr 'expr) accum))))))
6.87+ (defun get-ref-columns (exprs)
6.88+ (let ((accum))
6.89+ (loop for expr across exprs
6.90+ collect (visit expr accum))))
6.91+ (defun get-selection-ref-columns (select table)
6.92+ (let ((accum))
6.93+ (when (slot-value select 'selection)
6.94+ (let ((filter-expr (make-sql-logical-expression (slot-value select 'selection) table)))
6.95+ (visit filter-expr accum)
6.96+ (let ((valid-cols (map 'list (lambda (x) (field-name x)) (fields (schema table)))))
6.97+ (remove-if (lambda (x) (not (member x valid-cols :test 'string-equal))) accum)))))))
6.98
6.99+(defun plan-non-aggregate-query (select df projection-expr column-names-in-selection column-names-in-projection)
6.100+ (let ((plan df))
6.101+ (unless (slot-value select 'selection)
6.102+ (return-from plan-non-aggregate-query (df-project plan projection-expr)))
6.103+ (let ((missing (member-if-not
6.104+ (lambda (x) (member x column-names-in-projection :test 'string-equal))
6.105+ column-names-in-selection)))
6.106+ (if (null missing)
6.107+ (setq plan (df-filter
6.108+ plan
6.109+ (make-sql-logical-expression
6.110+ (slot-value select 'selection)
6.111+ (setf plan (df-project plan projection-expr)))))
6.112+ (let ((n (length projection-expr)))
6.113+ (setq plan (df-filter plan
6.114+ (make-sql-logical-expression
6.115+ (slot-value select 'selection)
6.116+ (setf plan
6.117+ (df-project plan
6.118+ (merge 'vector
6.119+ projection-expr
6.120+ (mapcar
6.121+ (lambda (x) (make-instance 'column-expression :name x))
6.122+ missing)
6.123+ (lambda (x y) (declare (ignore y)) x)))))))
6.124+
6.125+ (df-project plan
6.126+ (coerce
6.127+ (loop for i below n
6.128+ collect (make-instance 'column-expression
6.129+ :name (field-name (field (schema plan) i))))
6.130+ 'vector))))
6.131+ plan)))
6.132+
6.133+(defun plan-aggregate-query (projection-expr select column-names-in-selection df aggregate-expr)
6.134+ (let ((plan df)
6.135+ (proj-no-agg (remove-if 'aggregate-expression-p projection-expr)))
6.136+ (when (slot-value select 'selection)
6.137+ (let* ((cols-in-proj-no-agg (get-ref-columns proj-no-agg))
6.138+ (missing (member-if-not
6.139+ (lambda (x) (member x cols-in-proj-no-agg :test 'string-equal))
6.140+ column-names-in-selection)))
6.141+ (if (null missing)
6.142+ (setq plan (df-filter
6.143+ plan
6.144+ (make-sql-logical-expression
6.145+ (slot-value select 'selection)
6.146+ (setf plan (df-project plan proj-no-agg)))))
6.147+ (setq plan (df-filter
6.148+ plan
6.149+ (make-sql-logical-expression
6.150+ (slot-value select 'selection)
6.151+ (setf plan
6.152+ (df-project plan
6.153+ (merge 'vector
6.154+ proj-no-agg
6.155+ (mapcar (lambda (x) (make-instance 'column-expression :name x))
6.156+ missing)
6.157+ (lambda (x y) (declare (ignore y)) x))))))))
6.158+ (df-aggregate plan
6.159+ (map 'vector (lambda (x) (make-sql-logical-expression x plan))
6.160+ (slot-value select 'group-by))
6.161+ aggregate-expr)))))
6.162+
6.163+;; TODO 2024-08-04: fix deadlock
6.164 (defun make-sql-data-frame (select tables)
6.165 (let* ((table (gethash (slot-value select 'table-name)
6.166 tables
6.167@@ -705,12 +824,19 @@
6.168 ;;; Optimizer
6.169 (defclass sql-optimizer (query-optimizer) ())
6.170
6.171+;;; Engine
6.172+(defclass sql-engine (query-engine) ()
6.173+ (:default-initargs
6.174+ :parser (make-instance 'sql-parser)))
6.175+
6.176 ;;; Top-level Macros
6.177 (defmacro with-sql ((sym input &key (parse t) optimize execute) &body body)
6.178- (declare (ignore optimize execute))
6.179 `(with-sql-parser (,sym ,@(etypecase input
6.180 (stream `((read-sql-stream ,input)))
6.181 (string `((read-sql-string ,input)))))
6.182- ,@(when parse
6.183- `((setq ,sym (parse ,sym))))
6.184+ ,@(cond
6.185+ (optimize `((setq ,sym (optimize (parse ,sym)))))
6.186+ (parse `((setq ,sym (parse ,sym)))))
6.187+ ,@(when execute
6.188+ `((execute (make-physical-plan ,sym))))
6.189 ,@body))
7.1--- a/lisp/lib/q/tests.lisp Sun Aug 04 16:58:23 2024 -0400
7.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
7.3@@ -1,80 +0,0 @@
7.4-;;; tests.lisp --- Q Tests
7.5-
7.6-;;
7.7-
7.8-;;; Code:
7.9-(defpackage :q/tests
7.10- (:use :cl :std :rt :q :log :parse/pratt :obj/query))
7.11-
7.12-(in-package :q/tests)
7.13-
7.14-(defsuite :q)
7.15-
7.16-(in-suite :q)
7.17-
7.18-(deftest sanity ())
7.19-
7.20-(deftest sql-select ()
7.21- (with-sql-parser (expr (read-sql-string "SELECT * FROM FOO"))
7.22- (is (typep (parse expr) 'sql-select))))
7.23-
7.24-(deftest sql-math ()
7.25- (with-sql (expr "1 + 2 * 3")
7.26- (is (typep expr 'sql-math-expression))
7.27- (is (typep (rhs expr) 'sql-math-expression))
7.28- (is (typep (lhs expr) 'sql-number))))
7.29-
7.30-;; https://www.cpp.edu/~jrfisher/www/prolog_tutorial/2_1.html
7.31-(deftest dql ()
7.32- (adjacent 1 2)
7.33- (adjacent 2 1)
7.34- (adjacent 1 3)
7.35- (adjacent 3 1)
7.36- (adjacent 1 4)
7.37- (adjacent 4 1)
7.38- (adjacent 1 5)
7.39- (adjacent 5 1)
7.40- (adjacent 2 3)
7.41- (adjacent 3 2)
7.42- (adjacent 2 4)
7.43- (adjacent 4 2)
7.44- (adjacent 3 4)
7.45- (adjacent 4 3)
7.46- (adjacent 4 5)
7.47- (adjacent 5 4)
7.48- (color 1 red a) (color 1 red b)
7.49- (color 2 blue a) (color 2 blue b)
7.50- (color 3 green a) (color 3 green b)
7.51- (color 4 yellow a) (color 4 blue b)
7.52- (color 5 blue a) (color 5 green b)
7.53-
7.54- (:- (conflict ?coloring)
7.55- (adjacent ?x ?y)
7.56- (color ?x ?color ?coloring)
7.57- (color ?y ?color ?coloring))
7.58-
7.59-
7.60- (:- (conflict ?r1 ?r2 ?coloring)
7.61- (adjacent ?r1 ?r2)
7.62- (color ?r1 ?color ?coloring)
7.63- (color ?r2 ?color ?coloring))
7.64-
7.65-
7.66- ;; there are several infix operators.
7.67- ;; :- , >, <, -> etc.
7.68- ;; let's mark variables with ? prefix.
7.69- ;;
7.70-
7.71- (:- main
7.72- (forall (conflict ?coloring)
7.73- (writeln (conflict ?coloring)))
7.74- (forall (conflict ?r1 ?r2 ?coloring)
7.75- (writeln (conflict ?r1 ?r2 ?coloring)))
7.76- (forall (conflict ?r1 ?r2 ?coloring)
7.77- (and (print-sexp (conflict ?r1 ?r2 ?coloring))
7.78- nl))
7.79- halt)
7.80-
7.81- (:- (initialization main))
7.82-
7.83- )
8.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2+++ b/lisp/lib/q/tests/fuzz.lisp Sun Aug 04 20:51:07 2024 -0400
8.3@@ -0,0 +1,12 @@
8.4+;;; fuzz.lisp --- Q Fuzzers
8.5+
8.6+;; Q Test Fuzzers
8.7+
8.8+;;; Code:
8.9+(in-package :q/tests/fuzz)
8.10+
8.11+(defclass query-fuzzer (fuzzer) ())
8.12+
8.13+(defclass sql-fuzzer (query-fuzzer) ())
8.14+
8.15+(defclass dql-fuzzer (query-fuzzer) ())
9.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2+++ b/lisp/lib/q/tests/pkg.lisp Sun Aug 04 20:51:07 2024 -0400
9.3@@ -0,0 +1,11 @@
9.4+;;; pkg.lisp
9.5+
9.6+;; Q Test Packages
9.7+
9.8+;;; Code:
9.9+(defpackage :q/tests/fuzz
9.10+ (:use :cl :std :rt/fuzz :q :log))
9.11+
9.12+(defpackage :q/tests
9.13+ (:use :cl :std :rt :q :log :parse/pratt :obj/query))
9.14+
10.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2+++ b/lisp/lib/q/tests/suite.lisp Sun Aug 04 20:51:07 2024 -0400
10.3@@ -0,0 +1,83 @@
10.4+;;; tests.lisp --- Q Tests
10.5+
10.6+;;
10.7+
10.8+;;; Code:
10.9+(in-package :q/tests)
10.10+
10.11+(defsuite :q)
10.12+
10.13+(in-suite :q)
10.14+
10.15+(deftest sanity ()
10.16+ (is (make-instance 'query-engine :parser (make-instance 'query-parser))))
10.17+
10.18+(deftest sql-select ()
10.19+ (with-sql (expr "SELECT BAR FROM FOO")
10.20+ (is (typep expr 'sql-select))
10.21+ (let ((tbl (make-hash-table :test 'equal))
10.22+ (df (make-instance 'data-frame)))
10.23+ (setf (schema df) (make-schema))
10.24+ ;; (signals simple-sql-error (make-sql-data-frame expr tbl))
10.25+ (setf (gethash "FOO" tbl) df)
10.26+ ;; (make-sql-data-frame expr tbl))
10.27+ )))
10.28+
10.29+(deftest sql-math ()
10.30+ (with-sql (expr "1 + 2 * 3")
10.31+ (is (typep expr 'sql-math-expression))
10.32+ (is (typep (rhs expr) 'sql-math-expression))
10.33+ (is (typep (lhs expr) 'sql-number))))
10.34+
10.35+;; https://www.cpp.edu/~jrfisher/www/prolog_tutorial/2_1.html
10.36+(deftest dql (:skip t)
10.37+ (adjacent 1 2)
10.38+ (adjacent 2 1)
10.39+ (adjacent 1 3)
10.40+ (adjacent 3 1)
10.41+ (adjacent 1 4)
10.42+ (adjacent 4 1)
10.43+ (adjacent 1 5)
10.44+ (adjacent 5 1)
10.45+ (adjacent 2 3)
10.46+ (adjacent 3 2)
10.47+ (adjacent 2 4)
10.48+ (adjacent 4 2)
10.49+ (adjacent 3 4)
10.50+ (adjacent 4 3)
10.51+ (adjacent 4 5)
10.52+ (adjacent 5 4)
10.53+ (color 1 red a) (color 1 red b)
10.54+ (color 2 blue a) (color 2 blue b)
10.55+ (color 3 green a) (color 3 green b)
10.56+ (color 4 yellow a) (color 4 blue b)
10.57+ (color 5 blue a) (color 5 green b)
10.58+
10.59+ (:- (conflict ?coloring)
10.60+ (adjacent ?x ?y)
10.61+ (color ?x ?color ?coloring)
10.62+ (color ?y ?color ?coloring))
10.63+
10.64+
10.65+ (:- (conflict ?r1 ?r2 ?coloring)
10.66+ (adjacent ?r1 ?r2)
10.67+ (color ?r1 ?color ?coloring)
10.68+ (color ?r2 ?color ?coloring))
10.69+
10.70+
10.71+ ;; there are several infix operators.
10.72+ ;; :- , >, <, -> etc.
10.73+ ;; let's mark variables with ? prefix.
10.74+ ;;
10.75+
10.76+ (:- main
10.77+ (forall (conflict ?coloring)
10.78+ (writeln (conflict ?coloring)))
10.79+ (forall (conflict ?r1 ?r2 ?coloring)
10.80+ (writeln (conflict ?r1 ?r2 ?coloring)))
10.81+ (forall (conflict ?r1 ?r2 ?coloring)
10.82+ (and (print-sexp (conflict ?r1 ?r2 ?coloring))
10.83+ nl))
10.84+ halt)
10.85+
10.86+ (:- (initialization main)))
11.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
11.2+++ b/lisp/lib/rt/fuzz.lisp Sun Aug 04 20:51:07 2024 -0400
11.3@@ -0,0 +1,12 @@
11.4+;;; fuzz.lisp --- RT Fuzz
11.5+
11.6+;; FUZZER API
11.7+
11.8+;;; Code:
11.9+(in-package :rt/fuzz)
11.10+
11.11+(defclass fuzzer ()
11.12+ ((state)))
11.13+
11.14+(defgeneric fuzz (self &optional n))
11.15+(defgeneric fuzz* (self &key &allow-other-keys))
12.1--- a/lisp/lib/rt/pkg.lisp Sun Aug 04 16:58:23 2024 -0400
12.2+++ b/lisp/lib/rt/pkg.lisp Sun Aug 04 20:51:07 2024 -0400
12.3@@ -130,6 +130,13 @@
12.4 (:use :cl :std :log :rt :sb-sprof)
12.5 (:export :save-flamegraph))
12.6
12.7+(defpackage :rt/fuzz
12.8+ (:nicknames :fuzz)
12.9+ (:use :cl :std :log :rt)
12.10+ (:export :fuzzer
12.11+ :fuzz
12.12+ :fuzz*))
12.13+
12.14 (in-package :rt)
12.15 (in-readtable :std)
12.16
13.1--- a/lisp/lib/rt/rt.asd Sun Aug 04 16:58:23 2024 -0400
13.2+++ b/lisp/lib/rt/rt.asd Sun Aug 04 20:51:07 2024 -0400
13.3@@ -5,7 +5,8 @@
13.4 (:file "bench" :depends-on ("pkg"))
13.5 (:file "tracing" :depends-on ("pkg"))
13.6 (:file "flamegraph" :depends-on ("pkg"))
13.7- (:file "cover" :depends-on ("pkg")))
13.8+ (:file "cover" :depends-on ("pkg"))
13.9+ (:file "fuzz" :depends-on ("pkg")))
13.10 :in-order-to ((test-op (test-op "rt/tests"))))
13.11
13.12 (defsystem :rt/tests
