cor/scheme-dql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix alter.

Browse source 
Prevent select from returning illegal alist if association not found.
Change source folder and update live make target.
This commit is contained in:
Cor Legemaat 2025-10-17 13:18:09 +02:00
commit 736783c607
4 changed files with 29 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Makefile.am
View file

@ -25,6 +25,7 @@ dist_doc_DATA = \
INSTALL \ INSTALL \
NEWS NEWS
# To use README.org instead of README.
README: README.org README: README.org
AUTHORS: AUTHORS:
@ -40,8 +41,9 @@ release-tag:
$(shell git push origin "v$(VERSION)") $(shell git push origin "v$(VERSION)")
live: live:
mkdir -p /usr/share/guile/site/dql sudo mkdir -p $(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/dql
mount --bind -o ro dql /usr/share/guile/site/dql/ sudo mount --bind -o ro dql \
$(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/dql/
# Remove doc directory on uninstall # Remove doc directory on uninstall
uninstall-local: uninstall-local:

2
configure.ac
View file

@ -16,7 +16,7 @@ scheme-dql. If not, see <https://www.gnu.org/licenses/>.
m4_define([version_major], [0]) m4_define([version_major], [0])
m4_define([version_minor], [0]) m4_define([version_minor], [0])
m4_define([version_revision], [0]) m4_define([version_revision], [1])
AC_PACKAGE_URL([http://www.cor.za.net/code/scheme-dql]) AC_PACKAGE_URL([http://www.cor.za.net/code/scheme-dql])
AC_INIT(scheme-dql, AC_INIT(scheme-dql,

2
dql/Makefile.am
View file

@ -37,7 +37,7 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
CLEANFILES = $(GOBJECTS) CLEANFILES = $(GOBJECTS)
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
GUILE_OPTS = -L $(abs_top_builddir)/src GUILE_OPTS = -L $(abs_top_builddir)/dql
SUFFIXES = .scm .go SUFFIXES = .scm .go
.scm.go: .scm.go:
$(GUILD) compile $(GUILE_TARGET) $(GUILE_OPTS) $(GUILE_WARNINGS) -o "$@" "$<" $(GUILD) compile $(GUILE_TARGET) $(GUILE_OPTS) $(GUILE_WARNINGS) -o "$@" "$<"

47
dql/dql.scm
View file

@ -270,6 +270,7 @@ syntax is fixed from SQL like how irregex fixed regular expressions.
`(set! ,entry `(set! ,entry
(assoc-remove! ,entry (assoc-remove! ,entry
,(second parm)))) ,(second parm))))
((eq? (car parm) 'where) #f)
(else (error (string-append "Illegal parameter \"" (else (error (string-append "Illegal parameter \""
(symbol->string (car parm)) (symbol->string (car parm))
"\" for alter"))))))) "\" for alter")))))))
@ -279,19 +280,19 @@ syntax is fixed from SQL like how irregex fixed regular expressions.
(if (first-parm-other (cdr query) (if (first-parm-other (cdr query)
'where) 'where)
#t #t
(dql-boolean-where 'where (dql-boolean-where 'and
(cadr query) (cadr query)
entry)) entry))
(if (first-parm-other query 'where) (if (first-parm-other query 'where)
#t #t
(dql-boolean-where 'where (dql-boolean-where 'and
(car query) (list (car query))
entry)))) entry))))
(list (append (list 'begin) (list (append (list 'begin)
(map parm->code (filter-map parm->code
(if fpo (if fpo
(cdr query) (cdr query)
query)))))) query))))))
(list entry)) (list entry))
(dql-data->list ,(if fpo (dql-data->list ,(if fpo
(map-query-symbols (car query) data) (map-query-symbols (car query) data)
@ -301,7 +302,7 @@ syntax is fixed from SQL like how irregex fixed regular expressions.
(lambda (query data) (lambda (query data)
"Function to return the code that will select a subsections of the "Function to return the code that will select a subsections of the
associations of the alist data entries based on the @code{parm}, associations of the alist data entries based on the @code{parm},
@code{parm-as} and @code{parm-val} rules of the query. and @code{parm-as} rules of the query.
@strong{query} (dql-query): @strong{query} (dql-query):
The query to generate the code for. The query to generate the code for.
@ -312,7 +313,9 @@ syntax is fixed from SQL like how irregex fixed regular expressions.
@strong{return} (code): @strong{return} (code):
The code that will process the data according to the query." The code that will process the data according to the query."
(let* ((fpo (first-parm-other query 'parm 'parm-as 'parm-val)) (let* ((fpo (first-parm-other query 'parm 'parm-as 'parm-val))
(entry (gensym)) (entry (gensym))
(answ (gensym))
(responce (gensym))
(parm->code (parm->code
(lambda (parm) (lambda (parm)
(cond ((eq? (car parm) 'parm) (cond ((eq? (car parm) 'parm)
@ -322,25 +325,21 @@ syntax is fixed from SQL like how irregex fixed regular expressions.
,(if (null? rest-parms) ,(if (null? rest-parms)
entry entry
(path-val rest-parms (path-val rest-parms
entry))))) entry)))))
((eq? (car parm) 'parm-as) ((eq? (car parm) 'parm-as)
`(cons ,(car (cdr parm)) `(let ((,answ ,(path-val (cdr (cdr parm))
,(path-val (cdr (cdr parm)) entry)))
entry))) (if ,answ
((eq? (car parm) 'parm-val) (cons ,(car (cdr parm))
(let ((last-parm (last parm)) ,answ)
(rest-parms (drop-right (cdr parm) 1))) #f)))
`(assoc-ref ,(if (null? rest-parms)
entry
(path-val rest-parms
entry))
,last-parm)))
(else (else
(error "Illegal parameter for select.")))))) (error "Illegal parameter for select."))))))
`(map (lambda (,entry) `(map (lambda (,entry)
,(append (list 'list) (filter-map (lambda (,responce) ,responce)
(map parm->code ,(append (list 'list)
(if fpo (cdr query) query)))) (map parm->code
(if fpo (cdr query) query)))))
(dql-data->list ,(if fpo (dql-data->list ,(if fpo
(map-query-symbols (car query) data) (map-query-symbols (car query) data)
data)))))) data))))))