changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: sql updates, fuzzz

changeset 582: 568c39371122
parent 581: d3e2829521a3
child 583: 1a0df4444a9f
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 07 Aug 2024 21:09:43 -0400
files: lisp/lib/obj/pkg.lisp lisp/lib/obj/query.lisp lisp/lib/q/sql.lisp lisp/lib/q/tests/fuzz.lisp lisp/lib/q/tests/pkg.lisp lisp/lib/q/tests/suite.lisp lisp/lib/rt/fuzz.lisp lisp/lib/rt/pkg.lisp
description: sql updates, fuzzz
     1.1--- a/lisp/lib/obj/pkg.lisp	Tue Aug 06 21:17:24 2024 -0400
     1.2+++ b/lisp/lib/obj/pkg.lisp	Wed Aug 07 21:09:43 2024 -0400
     1.3@@ -461,7 +461,8 @@
     1.4            :projection-pushdown-optimizer
     1.5            :extract-columns*
     1.6            :extract-columns
     1.7-           :query-vop))
     1.8+           :query-vop
     1.9+           :expr))
    1.10 
    1.11 (defpackage :obj/secret
    1.12   (:nicknames :secret)
     2.1--- a/lisp/lib/obj/query.lisp	Tue Aug 06 21:17:24 2024 -0400
     2.2+++ b/lisp/lib/obj/query.lisp	Wed Aug 07 21:09:43 2024 -0400
     2.3@@ -101,7 +101,10 @@
     2.4 ;;; Record Batch
     2.5 (defstruct record-batch
     2.6   (schema (make-schema) :type schema)
     2.7-  (fields #() :type field-vector))
     2.8+  (fields #() :type column-vector))
     2.9+
    2.10+(defmethod schema ((self record-batch))
    2.11+  (record-batch-schema self))
    2.12 
    2.13 (defmethod make-load-form ((self record-batch) &optional env)
    2.14   (declare (ignore env))
    2.15@@ -328,7 +331,8 @@
    2.16 
    2.17 (defgeneric aggregate-expression-p (self)
    2.18   (:method ((self aggregate-expression)) t)
    2.19-  (:method ((self alias-expression)) (aggregate-expression-p (expr self))))
    2.20+  (:method ((self alias-expression)) (aggregate-expression-p (expr self)))
    2.21+  (:method ((self t)) nil))
    2.22 
    2.23 (defmethod to-field ((self aggregate-expression) (input logical-plan))
    2.24   (declare (ignorable input))
    2.25@@ -479,6 +483,7 @@
    2.26   (plan (make-instance 'logical-plan) :type logical-plan))
    2.27 
    2.28 (defgeneric df-col (self))
    2.29+
    2.30 (defgeneric df-project (df exprs)
    2.31   (:method ((df data-frame) (expr list))
    2.32     (df-project df (coerce expr 'vector)))
    2.33@@ -505,7 +510,9 @@
    2.34   (:method ((df data-frame) (group-by list) (agg-expr list))
    2.35     (df-aggregate df (coerce group-by 'vector) (coerce agg-expr 'vector))))
    2.36 
    2.37-(defgeneric make-df (&rest initargs &key &allow-other-keys))
    2.38+(defgeneric make-df (self &key &allow-other-keys)
    2.39+  (:method ((self null) &key)
    2.40+    (make-data-frame)))
    2.41 
    2.42 (defmethod schema ((df data-frame))
    2.43   (schema (data-frame-plan df)))
     3.1--- a/lisp/lib/q/sql.lisp	Tue Aug 06 21:17:24 2024 -0400
     3.2+++ b/lisp/lib/q/sql.lisp	Wed Aug 07 21:09:43 2024 -0400
     3.3@@ -43,6 +43,8 @@
     3.4 (defclass sql-data-source (data-source) ()
     3.5   (:documentation "Data source which can be used within SQL expressions."))
     3.6 
     3.7+;; SQL-EXPRESSIONs are the output of a SQL-PARSER. These objects are further
     3.8+;; lowered to LOGICAL-EXPRESSIONs.
     3.9 (defclass sql-expression () ())
    3.10 
    3.11 (deftype sql-expression-vector () '(vector sql-expression))
    3.12@@ -667,8 +669,6 @@
    3.13      ,@body))
    3.14 
    3.15 ;;; Planner
    3.16-(defclass sql-planner (query-planner) ())
    3.17-
    3.18 (defun make-sql-logical-expression (expr input)
    3.19   (etypecase expr
    3.20     (sql-identifier (make-instance 'column-expression :name (id expr)))
    3.21@@ -800,9 +800,13 @@
    3.22                       aggregate-expr)))))
    3.23 
    3.24 (defun make-sql-data-frame (select tables)
    3.25-  (let* ((table (gethash (slot-value select 'table-name)
    3.26-                         tables
    3.27-                         (simple-sql-error "No table named ~A" (slot-value select 'table-name))))
    3.28+  "Process the given SELECT statement with the provided hash-table of
    3.29+string:data-frame. Returns a data-frame."
    3.30+  (let* ((table (or
    3.31+                 (gethash (slot-value select 'table-name)
    3.32+                          tables
    3.33+                          )
    3.34+                 (simple-sql-error "No table named ~A" (slot-value select 'table-name))))
    3.35          (proj (map 'vector
    3.36                     (lambda (x) (make-sql-logical-expression x table))
    3.37                     (slot-value select 'projection)))
    3.38@@ -818,7 +822,35 @@
    3.39                 (agg)
    3.40                 (n-group-cols 0)
    3.41                 (group-count 0))
    3.42-            plan)))))
    3.43+            (declare (fixnum n-group-cols group-count))
    3.44+            (loop for expr across proj
    3.45+                  do (typecase expr
    3.46+                       (aggregate-expression
    3.47+                        (progn
    3.48+                          (push (+ n-group-cols (length agg)) pro)
    3.49+                          (push expr agg)))
    3.50+                       (alias-expression
    3.51+                        (progn
    3.52+                          (push (make-instance 'alias-expression
    3.53+                                  :name (+ n-group-cols (length agg))
    3.54+                                  :expr (slot-value expr 'alias))
    3.55+                                pro)
    3.56+                          ;; TODO 2024-08-07: does this need to be cast to aggregate-expression?
    3.57+                          (push (expr expr) agg)))
    3.58+                       (t (progn
    3.59+                            (push group-count pro)
    3.60+                            (incf group-count)))))
    3.61+            (let ((plan
    3.62+                    (df-project
    3.63+                     (plan-aggregate-query proj select cols-in-sel plan agg)
    3.64+                     pro)))
    3.65+              (if-let ((having (slot-value select 'having)))
    3.66+                (df-filter plan (make-sql-logical-expression having plan))
    3.67+                plan)))))))
    3.68+
    3.69+(defmethod make-df ((self sql-select) &key tables &allow-other-keys)
    3.70+  (when tables
    3.71+    (make-sql-data-frame self tables)))
    3.72 
    3.73 ;;; Optimizer
    3.74 (defclass sql-optimizer (query-optimizer) ())
     4.1--- a/lisp/lib/q/tests/fuzz.lisp	Tue Aug 06 21:17:24 2024 -0400
     4.2+++ b/lisp/lib/q/tests/fuzz.lisp	Wed Aug 07 21:09:43 2024 -0400
     4.3@@ -5,8 +5,27 @@
     4.4 ;;; Code:
     4.5 (in-package :q/tests/fuzz)
     4.6 
     4.7-(defclass query-fuzzer (fuzzer) (data-source))
     4.8+(defvar *fuzz-value-max-size* 32)
     4.9+
    4.10+;; > schema, state, generator
    4.11+(defclass query-fuzzer (fuzzer data-source) ())
    4.12+
    4.13+(defun generate-sql-type (state &optional (type :string))
    4.14+  (case type
    4.15+    (:integer (make-instance 'sql-number :value (random most-positive-fixnum)))
    4.16+    (:float (make-instance 'sql-number :value (random most-positive-single-float)))
    4.17+    (:double (make-instance 'sql-number :value (random most-positive-double-float)))
    4.18+    (:string (make-instance 'sql-string :value (rt:random-chars (random *fuzz-value-max-size* state))))))
    4.19 
    4.20-(defclass sql-fuzzer (query-fuzzer) ())
    4.21+(defun generate-dql-type (state &optional (type :string)))
    4.22+
    4.23+(defclass sql-fuzzer (query-fuzzer) ()
    4.24+  (:default-initargs
    4.25+   :generator #'generate-sql-type))
    4.26 
    4.27-(defclass dql-fuzzer (query-fuzzer) ())
    4.28+(defmethod fuzz ((self sql-fuzzer) &key type)
    4.29+  (funcall (fuzz-generator self) (fuzz-state self) type))
    4.30+
    4.31+(defclass dql-fuzzer (query-fuzzer) ()
    4.32+  (:default-initargs
    4.33+   :generator #'generate-dql-type))
     5.1--- a/lisp/lib/q/tests/pkg.lisp	Tue Aug 06 21:17:24 2024 -0400
     5.2+++ b/lisp/lib/q/tests/pkg.lisp	Wed Aug 07 21:09:43 2024 -0400
     5.3@@ -4,7 +4,7 @@
     5.4 
     5.5 ;;; Code:
     5.6 (defpackage :q/tests/fuzz
     5.7-  (:use :cl :std :rt/fuzz :q :log))
     5.8+  (:use :cl :std :rt/fuzz :q :log :obj/query))
     5.9 
    5.10 (defpackage :q/tests
    5.11   (:use :cl :std :rt :q :log :parse/pratt :obj/query))
     6.1--- a/lisp/lib/q/tests/suite.lisp	Tue Aug 06 21:17:24 2024 -0400
     6.2+++ b/lisp/lib/q/tests/suite.lisp	Wed Aug 07 21:09:43 2024 -0400
     6.3@@ -16,18 +16,12 @@
     6.4         :sources nil)))
     6.5 
     6.6 (deftest sql-select ()
     6.7-  (with-sql (expr "SELECT * FROM FOO")
     6.8+  (setf (gethash "FOO" tbl) (make-df nil))
     6.9+  (with-sql (expr "SELECT I FROM FOO")
    6.10     (is (typep expr 'sql-select))
    6.11-      (signals simple-sql-error (make-sql-data-frame expr tbl))))
    6.12-
    6.13-(deftest sql-df ()
    6.14-  (let ((tbl (make-hash-table :test 'equal))
    6.15-        (df (make-instance 'data-frame)))
    6.16-    (setf (schema df) (make-schema))
    6.17-    (is (setf (gethash "FOO" tbl) df))
    6.18-    (is (gethash "FOO" tbl))
    6.19-    ;; (is (make-sql-data-frame df tbl))
    6.20-    ))
    6.21+    (let ((tbl (make-hash-table :test 'equalp)))
    6.22+      (is (gethash "FOO" tbl))
    6.23+      (make-sql-data-frame expr tbl))))
    6.24 
    6.25 (deftest sql-math ()
    6.26   (with-sql (expr "1 + 2 * 3")
     7.1--- a/lisp/lib/rt/fuzz.lisp	Tue Aug 06 21:17:24 2024 -0400
     7.2+++ b/lisp/lib/rt/fuzz.lisp	Wed Aug 07 21:09:43 2024 -0400
     7.3@@ -17,21 +17,23 @@
     7.4 (defclass fuzzer ()
     7.5   ((state :initform (make-random-state t)
     7.6     :initarg :state
     7.7-          :accessor fuzzer-state)
     7.8+          :accessor fuzz-state)
     7.9    (generator :initform *default-fuzz-generator*
    7.10               :initarg :generator
    7.11-              :type (function (state))
    7.12+              :type function
    7.13               :accessor fuzz-generator))
    7.14   (:documentation "An object which provides invalid, unexpected or random data as inputs to some
    7.15 program."))
    7.16 
    7.17 (defgeneric fuzz (self &key &allow-other-keys)
    7.18+  (:method ((self fuzzer) &key &allow-other-keys)
    7.19+    (funcall (the function (fuzz-generator self)) (fuzz-state self)))
    7.20   (:method ((self fuzzer) &key count)
    7.21     (if count
    7.22         (let ((ret))
    7.23           (dotimes (i count ret)
    7.24-            (push (funcall (the function (fuzz-generator self)) (fuzzer-state self)) ret)))
    7.25-        (funcall (the function (fuzz-generator self)) (fuzzer-state self)))))
    7.26+            (push (funcall (the function (fuzz-generator self)) (fuzz-state self)) ret)))
    7.27+        (fuzz self))))
    7.28 
    7.29 (defgeneric fuzz* (state generator &key &allow-other-keys)
    7.30   (:method ((state list) (generator function) &key (count 1))
     8.1--- a/lisp/lib/rt/pkg.lisp	Tue Aug 06 21:17:24 2024 -0400
     8.2+++ b/lisp/lib/rt/pkg.lisp	Wed Aug 07 21:09:43 2024 -0400
     8.3@@ -135,7 +135,9 @@
     8.4   (:use :cl :std :log :rt)
     8.5   (:export :fuzzer
     8.6            :fuzz
     8.7-           :fuzz*))
     8.8+           :fuzz*
     8.9+           :fuzz-generator
    8.10+           :fuzz-state))
    8.11 
    8.12 (in-package :rt)
    8.13 (in-readtable :std)