Skip to content

Commit

Permalink
Treat empty selection as select all and various refactorings.
Browse files Browse the repository at this point in the history
  • Loading branch information
@m00natic
m00natic committed Sep 10, 2018
1 parent 49355df commit af1f3a5
Show file tree
Hide file tree
Showing 5 changed files with 115 additions and 116 deletions.
8 changes: 4 additions & 4 deletions README.org
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,9 +68,8 @@ Here's what has to be done:

- implement appropriate *gen-do-lines* method over this new spec class

That is the minimum. You'll have to see if the default
implementations of *gen-select*, *gen-print-selection*,
*gen-list-selection* and *gen-cnt* suit your *gen-do-lines*
That is the minimum. You'll have to check if the default
implementations of *gen-select* and *gen-cnt* suit your *gen-do-lines*
implementation. The default implementations expect fully populated
string line.

Expand All @@ -91,7 +90,8 @@ operations. Here's what's available:
- *gen-where* translates WHERE tree to concrete code; it's meant to be
used within the body of *gen-do-lines*

Look at *gen-select* for an example.
Look at *gen-cnt* for a simple example or *gen-select* for a more
complex one.

* Future TODO

Expand Down
12 changes: 8 additions & 4 deletions fdbq.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,17 +4,21 @@

(defun select* (field-list db &key where print (jobs 1))
"Select FIELD-LIST from DB with WHERE filter."
(funcall (compile nil (gen-select (get-spec db) field-list where print jobs))))
(let ((spec (get-spec db)))
(run-compiled (gen-select spec (get-select-fields spec field-list)
where print jobs))))

(defmacro select (field-list db &key where (print t) (jobs 1))
"Select FIELD-LIST from DB with WHERE filter."
`(funcall (compile nil ,(gen-select (get-spec db) field-list where print jobs))))
`(run-compiled ,(let ((spec (get-spec db)))
(gen-select spec (get-select-fields spec field-list)
where print jobs))))

(defun cnt* (db &key where (jobs 1))
"Count FIELD-LIST from DB with WHERE filter."
(funcall (compile nil (gen-cnt (get-spec db) where jobs))))
(run-compiled (gen-cnt (get-spec db) where jobs)))

(defmacro cnt (db &key where (jobs 1))
"Count FIELD-LIST from DB with WHERE filter."
`(funcall (compile nil ,(gen-cnt (get-spec db) where jobs))))
`(run-compiled ,(gen-cnt (get-spec db) where jobs)))

54 changes: 31 additions & 23 deletions spec.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,45 +5,53 @@
(defvar *dbs* (make-hash-table :test 'eq)
"Registered DBs.")

(defclass db-field ()
((offset :type fixnum :reader db-field-offset :initarg :offset)
(size :type fixnum :reader db-field-size :initarg :size)))
(defclass spec-field ()
((name :type string :reader field-name :initarg :name)
(offset :type fixnum :reader field-offset :initarg :offset)
(size :type fixnum :reader field-size :initarg :size)))

(defclass operand-traits (db-field)
(defclass operand-traits (spec-field)
((filter :initarg :filter :initform nil)))

(defclass spec ()
((fields :type hash-table :accessor spec-fields
:initform (make-hash-table :test 'eq))
(field-list :type simple-array :accessor field-list)
(size :type fixnum :accessor spec-size :initform 0))
(:documentation "DB specification base information.
Contains named fields with offsets and sizes."))

(defun get-spec (db)
(gethash db *dbs*))

(defun field-offset (field spec)
(db-field-offset (gethash field (spec-fields spec))))

(defun field-size (field spec)
(db-field-size (gethash field (spec-fields spec))))

(defgeneric defspec (name type fields &key &allow-other-keys)
(:documentation "Register db with NAME, TYPE and list of FIELDS.
Additional ARGS depend on type."))

(defun defspec-fields (spec fields)
(defun defspec-read-fields (spec fields)
"Fill SPEC schema with FIELDS and inferred entry size."
(let ((spec-fields (spec-fields spec))
(size 0))
(dolist (field-spec fields)
(if (numberp field-spec)
(incf size field-spec)
(let ((field (make-instance 'db-field :offset size
:size (second field-spec))))
(setf (gethash (first field-spec) spec-fields) field)
(incf size (db-field-size field)))))
(setf (spec-size spec) size)))
(let ((size 0)
(spec-fields (spec-fields spec)))
(setf (field-list spec)
(make-array (count-if #'consp fields)
:element-type 'spec-field
:initial-contents
(loop for field in fields
for field-size = (if (numberp field)
field
(second field))
unless (numberp field)
collect (make-instance 'spec-field
:name (symbol-name (first field))
:offset size :size field-size)
do (incf size field-size)))
(spec-size spec) size)
(let ((field-list (field-list spec)))
(loop for field in fields
with field-index = 0
unless (numberp field)
do (setf (gethash (first field) spec-fields) (aref field-list field-index))
(incf field-index)))))

(defgeneric get-operand-traits (operand spec)
(:documentation "Determine OPERAND dimensions according to SPEC."))
Expand All @@ -58,5 +66,5 @@ Additional ARGS depend on type."))
(defmethod get-operand-traits ((operand symbol) spec)
"Get dimensions of field OPERAND according to SPEC."
(let ((field (gethash operand (spec-fields spec))))
(make-instance 'operand-traits :offset (db-field-offset field)
:size (db-field-size field))))
(make-instance 'operand-traits :offset (field-offset field)
:size (field-size field))))
58 changes: 9 additions & 49 deletions storage-file.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,33 +11,29 @@
(defmethod defspec (name (type (eql :file)) fields &key path)
"Register file DB with NAME, list of FIELDS and file PATH."
(let ((spec (make-instance 'spec-file :path (merge-pathnames path))))
(defspec-fields spec fields)
(defspec-read-fields spec fields)
(setf (gethash name *dbs*) spec)))

(defmethod gen-select ((spec spec-file) field-list where print jobs)
"Generate selection procedure for FIELD-LIST from DB with WHERE filter."
`(lambda () (declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0)))
`(lambda () (declare ,*optimize*)
,(cond
((and print (= 1 jobs))
(gen-do-lines spec 'line
`((when ,(or (gen-where where 'line spec 'buffer 'offset) t)
,(gen-print-selection spec field-list 'line
:buffer-var 'buffer
:offset-var 'offset)))
,(gen-print-selection field-list 'buffer 'offset)))
:buffer-var 'buffer :offset-var 'offset))
(print
(alexandria:with-gensyms (reduce-print)
`(flet ((,reduce-print (vec1 vec2)
(declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0))
(declare ,*optimize*
(type (vector (simple-array simple-base-string)) vec1 vec2))
,(gen-print-select-results 'vec2 (length field-list))
vec1))
(declare (inline ,reduce-print))
,(gen-do-lines spec 'line
`((when ,(or (gen-where where 'line spec 'buffer 'offset) t)
,(gen-list-selection spec field-list 'line 'result
:buffer-var 'buffer
:offset-var 'offset)))
,(gen-list-selection field-list 'buffer 'result 'offset)))
:buffer-var 'buffer :offset-var 'offset
:reduce-fn reduce-print :jobs jobs
:result-var 'result
Expand All @@ -46,53 +42,17 @@
(,(length field-list))))))))
(t (gen-do-lines spec 'line
`((when ,(or (gen-where where 'line spec 'buffer 'offset) t)
,(gen-list-selection spec field-list 'line 'result
:buffer-var 'buffer
:offset-var 'offset)))
,(gen-list-selection field-list 'buffer 'result 'offset)))
:buffer-var 'buffer :offset-var 'offset
:reduce-fn (if print 'reduce-print 'append-vec)
:jobs jobs :result-var 'result
:result-initform '(make-array 0 :fill-pointer t :adjustable t)
:result-type `(vector (simple-array simple-base-string
(,(length field-list)))))))))

(defmethod gen-print-selection ((spec spec-file) fields line-var
&key buffer-var offset-var)
"Unroll selected FIELDS' print statements.
BUFFER-VAR is symbol representing the db buffer.
OFFSET-VAR is symbol representing the current offset in the db buffer."
(declare (ignore line-var))
`(progn
,@(loop for field in fields ;collect print statements in list and splice them
collect '(write-char #\|)
collect `(loop for i fixnum from (+ ,offset-var
,(field-offset field spec))
below (+ ,offset-var ,(+ (field-offset field spec)
(field-size field spec)))
do (write-char (code-char (aref ,buffer-var i)))))
(format t "|~%")))

(defmethod gen-list-selection ((spec spec-file) fields line-var result
&key buffer-var offset-var)
"Unroll selected FIELDS' gather statements.
BUFFER-VAR is symbol representing the db buffer.
OFFSET-VAR is symbol representing the current offset in the db buffer."
(declare (ignore line-var))
`(let ((res (make-array ,(length fields))))
,@(loop for field in fields
for i fixnum from 0
collect `(setf (aref res ,i)
(let ((field-str (make-string ,(field-size field spec)
:element-type 'base-char)))
(loop for i fixnum from 0 below ,(field-size field spec)
for j fixnum from (+ ,offset-var ,(field-offset field spec))
do (setf (aref field-str i) (code-char (aref ,buffer-var j))))
field-str)))
(vector-push-extend res ,result)))

(defmethod gen-cnt ((spec spec-file) where jobs)
"Generate count procedure over DB with WHERE filter over file."
`(lambda () (declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0)))
`(lambda () (declare ,*optimize*)
,(gen-do-lines spec 'line
`((when ,(or (gen-where where 'line spec 'buffer 'offset) t)
(incf result)))
Expand Down Expand Up @@ -136,7 +96,7 @@ to raw byte buffer and current line offset within it respectively."
(with-open-file (,ins ,(spec-path spec) :direction :input
:element-type 'ascii:ub-char)
(flet ((mapper (,job-id)
(declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0))
(declare ,*optimize*
(type fixnum ,job-id))
(let ((,line-var (aref ,line-array ,job-id))
(,result-var ,result-initform)
Expand Down Expand Up @@ -246,7 +206,7 @@ to raw byte buffer and current line offset within it respectively."
`((dynamic-extent ,line-array))
`((dynamic-extent ,buffer-array ,line-array))))
(flet ((mapper (,take-end ,job-id ,portion-id)
(declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0))
(declare ,*optimize*
(type fixnum ,take-end ,job-id)
,(if threading?
`(type fixnum ,portion-id)
Expand Down
Loading

0 comments on commit af1f3a5

Please sign in to comment.