Skip to content

Commit

Permalink
Use vectors instead of lists to gather results.
Browse files Browse the repository at this point in the history
  • Loading branch information
@m00natic
m00natic committed Sep 4, 2018
1 parent 6959fc2 commit c594b3b
Show file tree
Hide file tree
Showing 4 changed files with 35 additions and 27 deletions.
2 changes: 1 addition & 1 deletion README.org
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ Here's variation on the article example:
(< "180620" date_disc)
(< date_eff date_disc))
:jobs 4 ;parallelize
:print nil) ;return list of results instead of printing
:print nil) ;return array of results instead of printing
#+END_SRC

The *select* macro is meant for REPL usage. There's also analogous
Expand Down
1 change: 1 addition & 0 deletions package.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,4 +13,5 @@
#:gen-print-selection
#:gen-list-selection
#:gen-print-select-results
#:append-vec
#:gen-cnt))
18 changes: 9 additions & 9 deletions storage-file.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,18 +30,18 @@
:buffer-var 'buffer
:offset-var 'offset)))
:buffer-var 'buffer :offset-var 'offset
:reduce-fn 'nconc :jobs jobs
:result-var 'result :result-initform nil
:result-type 'list)))
:reduce-fn 'append-vec :jobs jobs
:result-var 'result
:result-initform '(make-array 0 :fill-pointer t)
:result-type `(vector (simple-array simple-base-string
(,(length field-list)))))))
,(if print
(gen-print-select-results 'res (length field-list))
'res)))))

(defmethod gen-print-selection ((spec spec-file) fields line-var
&key buffer-var offset-var)
"Unroll selected FIELDS' print statements.
LINE-VAR is symbol representing the current line variable.
SPEC holds field offset details.
BUFFER-VAR is symbol representing the db buffer.
OFFSET-VAR is symbol representing the current offset in the db buffer."
(declare (ignore line-var))
Expand All @@ -58,20 +58,20 @@ OFFSET-VAR is symbol representing the current offset in the db buffer."
(defmethod gen-list-selection ((spec spec-file) fields line-var result
&key buffer-var offset-var)
"Unroll selected FIELDS' gather statements.
LINE-VAR is symbol representing the current line variable.
SPEC holds field offset details."
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 from 0
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)))
(setf ,result (nconc ,result (list res)))))
(vector-push-extend res ,result)))

(defmethod gen-cnt ((spec spec-file) where jobs)
"Generate count procedure over DB with WHERE filter over file."
Expand Down
41 changes: 24 additions & 17 deletions utils.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,9 +28,11 @@ Default implementation using only string line."
`(let ((res ,(gen-do-lines spec 'line
`((when ,(or (gen-where where 'line spec) t)
,(gen-list-selection spec field-list 'line 'result)))
:reduce-fn 'nconc :jobs jobs
:result-var 'result :result-initform nil
:result-type 'list)))
:reduce-fn 'append-vec :jobs jobs
:result-var 'result
:result-initform '(make-array 0 :fill-pointer t)
:result-type `(vector (simple-array simple-base-string
(,(length field-list)))))))
,(if print
(gen-print-select-results 'res (length field-list))
'res)))))
Expand All @@ -55,18 +57,15 @@ SPEC holds field offset details."

(defun gen-print-select-results (res-var field-count)
"Pretty print list of results."
`(dolist (line ,res-var)
,(let* ((fmt-size (* 3 field-count))
(fmt-str (make-string (+ fmt-size 3) :element-type 'base-char)))
(loop for i from 0 below fmt-size by 3
do (setf (aref fmt-str i) #\|
(aref fmt-str (1+ i)) #\~
(aref fmt-str (+ 2 i)) #\A))
(setf (aref fmt-str fmt-size) #\|
(aref fmt-str (1+ fmt-size)) #\~
(aref fmt-str (+ 2 fmt-size)) #\%)
`(format t ,fmt-str ,@(loop for i from 0 below field-count
collect `(aref line ,i))))))
`(loop for i fixnum from 0 below (length ,res-var)
do (let ((line (aref ,res-var i)))
(declare (type (simple-array simple-base-string (,field-count)) line))
,(let ((fmt-str (with-output-to-string (s nil :element-type 'base-char)
(loop repeat field-count
do (write-string "|~A" s))
(write-string "|~%" s))))
`(format t ,fmt-str ,@(loop for i fixnum from 0 below field-count
collect `(aref line ,i)))))))

(defgeneric gen-list-selection (spec fields line-var result &key &allow-other-keys)
(:documentation "Generate FIELDS selection to list over SPEC db code.
Expand All @@ -79,11 +78,11 @@ LINE-VAR is symbol representing the current line variable.
SPEC holds field offset details."
`(let ((res (make-array ,(length fields) :element-type 'simple-base-string)))
,@(loop for field in fields
for i from 0
for i fixnum from 0
collect `(setf (aref res ,i) (subseq ,line-var ,(field-offset field spec)
:end ,(+ (field-offset field spec)
(field-size field spec)))))
(setf ,result (nconc ,result (list res)))))
(vector-push-extend res ,result)))

(defgeneric gen-cnt (spec where jobs)
(:documentation "Generate count procedure for SPEC db with WHERE filter."))
Expand All @@ -97,3 +96,11 @@ SPEC holds field offset details."
(incf result)))
:reduce-fn '+ :jobs jobs
:result-var 'result :result-initform 0 :result-type 'fixnum)))

(defun append-vec (vec1 vec2)
"Append VEC2 to the end of VEC1."
(declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0))
(type (vector (simple-array simple-base-string)) vec1 vec2))
(loop for el across vec2
do (vector-push-extend el vec1))
vec1)

0 comments on commit c594b3b

Please sign in to comment.